bonjour
lire données ds fichier fermé
Nécessite une référence à Microsoft ActiveX Data Objects 2.x Library
2 méthodes,commenter ou décommenter la ligne
commencant par GetExternalData
Sub LitDatas01()
Dim Fich$, Arr
Fich = 'E:\\Dossier\\Fichier.xls'
'1 récup des données à partir de l'adresse d'une plage de cellules
GetExternalData Fich, 'NomFeuille', 'G5:G8', False, Arr
'2 récup des données à partir du nom d'une plage de cellules ()
' GetExternalData Fich, '', 'plagenommée', False, Arr
With ThisWorkbook.Sheets('Feuil1')
.Cells(UBound(Arr, 1), UBound(Arr, 2))).Value = Arr
'.Columns('A:C').AutoFit
'MsgBox valeur(0)
End With
'Sheets('Feuil2').Columns('A:C').AutoFit
End Sub
'renvoie les valeurs d'une plage de cellules contigües (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)
'écrit par Hector Miguel, merçi
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
bonne chance
au revoir
:huh: