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 41 42 43 44 45 46 47 48 49 50 51 52
| Sub RequeteClasseurFerme2()
'EN cas d'exportation de cette macro vers un autre classeur ne pas oublier de cocher
' Menu outils/référénces/Microsoft ActiveX Data Objects 2.8 library
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim ADOCommand As ADODB.Command
Dim Fichier As String, Cellule As String, Feuille As String ', Cible As String
'Adresse de la cellule contenant la donnée à récupérer
Cellule = Saisie2.TextBox3
'Pour une plage de cellules, utilisez:
'Cellule = "A4:C10"
Feuille = Saisie2.TextBox2
'Exemple 03082009 All sites Overnight po pour l'OverNight
' ou 03082009 All sites Intraday p pour l'Intraday
Fichier = Saisie2.TextBox1
Set Source = New ADODB.Connection
Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
Set ADOCommand = New ADODB.Command
With ADOCommand
.ActiveConnection = Source
.CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
End With
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
' Range("Cible").Offset(0, 1).CopyFromRecordset Rst
ActiveCell.CopyFromRecordset Rst
Rst.Close
Source.Close
Set Source = Nothing
Set Rst = Nothing
Set ADOCommand = Nothing
Saisie2.Hide
End Sub |
Partager