Function extractionValeurCelluleClasseurFerme$()
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
'Adresse de la cellule contenant la donnée à récupérer
Cellule = "D6:D6"
'Pour une plage de cellules, utilisez:
'Cellule = "A4:C10"
Feuille = "Informations Diverses$" 'n'oubliez pas d'ajouter $ au nom de la feuille.
'Chemin complet du classeur fermé
Fichier = "N:\Projets en cours\1301001 Villa Fabien à Minergie\1301001 Villa Fabien à Minergie-Checkliste.xlsm"
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 & "]")
'Ecrit le résultat de la requête dans la cellule A2
Range("J45").CopyFromRecordset Rst
Rst.Close
Source.Close
Set Source = Nothing
Set Rst = Nothing
Set ADOCommand = Nothing
End Function