Bonjour SPEEDY,
J'ai recuperé cette infos sur le net et je te l'envoie
elle appartient à Frédéric Sigonneau
Cela va te demander un certains travail ....
Il est possible de lire et de récupérer des plages entières de cellules dans un classeur fermé en utilisant les objets ADO (ActiveX Data Objects).
Ci-dessous un exemple de code fonctionnel, à recopier dans un module standard du VBAProject de ton classeur "cible". Ce classeur "cible" doit comporter une référence à la bibliothèque
Microsoft ActiveX Data Objects 2.x Library.
C'est la procédure GetExternalData qui fait le travail. La procédure LitDatas se contente de l'appeler en lui passant les paramètres voulus et en renvoyant les données récupérées à l'endroit voulu.
'====================
Sub LitDatas()
Dim Fich$, Arr
Fich = "d:\TestDataToRead.xls"
'récup des données à partir de l'adresse d'une plage de cellules
GetExternalData Fich, "Feuil1", "A10:G20", False, Arr
'récup des données à partir du nom d'une plage de cellules
' GetExternalData Fich, "", "essainom", False, Arr
With ThisWorkbook.Sheets("Feuil1")
.Range("A1", .Cells(UBound(Arr, 1), UBound(Arr, 2))).Value = Arr
End With
End Sub
'renvoie les valeurs d'une plage de cellules (srcRange)
'd'une feuille (srcSheet) d'un fichier (srcFile) fermé
'dans un tableau (outArr)
'le paramètre TTL indique si la plage a ou non une ligne d'entêtes
Sub GetExternalData(srcFile As String, _
srcSheet As String, _
srcRange As String, _
TTL As Boolean, _
outArr As Variant)
'd'après Héctor Miguel, mpep
Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer
Dim Arr
Set myConn = New ADODB.Connection
If TTL = True Then HDR = "Yes" Else HDR = "No"
myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & srcFile & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & HDR & ";IMEX=1;"""
Set myCmd = New ADODB.Command
myCmd.ActiveConnection = myConn
If srcSheet = "" _
Then myCmd.CommandText = "SELECT * from `" & srcRange & "`" _
Else myCmd.CommandText = "SELECT * from `" & srcSheet & "$" & srcRange & "`"
Set myRS = New ADODB.Recordset
myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
myRS.MoveFirst
Do While Not myRS.EOF
For RS_n = 1 To myRS.RecordCount 'lignes
For RS_f = 0 To myRS.Fields.Count - 1 'colonnes
Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
Next
myRS.MoveNext
Next
Loop
myConn.Close
Set myRS = Nothing
Set myCmd = Nothing
Set myConn = Nothing
outArr = Arr
End Sub
A+ JMG