1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
| Sub macrodate()
Dim Message, Title, Default, MyValue
' Définit le message.
Message = "Entrez la date désirée"
Title = "Insertion d'une date" ' Définit le titre.
Default = Date
Default = Now
MyValue = InputBox(Message, Title, Default)
MyValue = MyValue & " 00:00:00"
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=C:\Users\ADRIENNE\Documents\Base de données1.accdb;DefaultDir=C:\Users\ADRIENNE\Documents;DriverId=2" _
), Array("5;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;")), Destination:= _
Range("$f$1")).QueryTable
.CommandText = Array( _
"SELECT ESSAIADRIENNE.`N°`, ESSAIADRIENNE.NOM, ESSAIADRIENNE.PRENOM, ESSAIADRIENNE.`DATE DE NAISSANCE`, ESSAIADRIENNE.`DATE D'ARRIVEE`" & Chr(13) & "" & Chr(10) & "FROM `C:\Users\ADRIENNE\Documents\Base de données1.accdb`.ESSAIAD" _
, _
"RIENNE ESSAIADRIENNE" & Chr(13) & "" & Chr(10) & "WHERE ESSAIADRIENNE.`DATE D'ARRIVEE`= " & MyValue & "ORDER BY ESSAIADRIENNE.`N°`" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = _
"Tableau_Lancer_la_requête_à_partir_de_MS_Access_Database_1"
.Refresh BackgroundQuery:=False
End With
End Sub |
Partager