bonjour
trouvé sur le web,pas testé
si cela peut t'aider
Attribute VB_Name = 'LireEcrireFichierFerme'
'Pour lire et écrire dans un classeur fermé en utilisant ADO,
'la bibliothèque
'Microsoft ActiveX Data Objects 2.x Library
'doit être cochée dans Outils\\Références du VBAProject.
' 1 - Obtenir des données d'un classeur fermé
Sub LitDatas()
Dim Fich$, Arr
Fich = 'd:\\TestAdo.xls' 'à adapter
'récup des données à partir de l'adresse d'une plage de cellules
GetExternalData Fich, 'Feuil1', 'A1:G20', False, Arr
'récup des données à partir du nom d'une plage de cellules ()
' GetExternalData Fich, '', 'plagenommée', 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 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)
'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
' 2 - Ecrire dans un classeur fermé
Sub EcritDatas()
Dim Fich$, cell As Range
Fich = 'd:\\TestAdo.xls' 'à adapter
'écrit dans le classeur fermé la valeur des cellules A1:A5
'du classeur actif
For Each cell In ActiveWorkbook.Sheets('Feuil1').Range('A1:A5')
SetExternalDatas Fich, 'Feuil1', cell.Address(0, 0), cell.Text
Next
'écrit en A6 la date et l'heure de l'opération
SetExternalDatas Fich, 'Feuil1', 'A6', 'mise à jour du ' & Now
'on regarde le résultat
DoEvents
Workbooks.Open Fich
End Sub
'écrit DataToWrite dans la cellule DestCellAdr
'de la feuille DestFeuille du classeur fermé DestFile
Sub SetExternalDatas(DestFile As String, _
DestFeuille As String, _
DestCellAdr As String, _
DataToWrite As Variant)
Dim oConn As ADODB.Connection
Dim oCmd As ADODB.Command
Dim oRS As ADODB.Recordset
Dim RangeDest
'd'après Rob Bovey, mpep
' Open a connection to the Excel spreadsheet
Set oConn = New ADODB.Connection
oConn.Open 'Provider=Microsoft.Jet.OLEDB.4.0;' & _
'Data Source=' & DestFile & ';' & _
'Extended Properties=''Excel 8.0;HDR=No;'';'
' Create a command object and set its ActiveConnection
Set oCmd = New ADODB.Command
oCmd.ActiveConnection = oConn
' This SQL statement selects a cell range in the 'feuilleTest' worksheet.
'1 Sélection pour écrire dans une seule cellule
RangeDest = DestCellAdr & ':' & DestCellAdr
oCmd.CommandText = 'SELECT * from `' & DestFeuille & '$' & RangeDest & '`'
' Open a recordset containing the worksheet data.
Set oRS = New ADODB.Recordset
oRS.Open oCmd, , adOpenKeyset, adLockOptimistic
' Update last row
oRS(0).Value = DataToWrite
oRS.Update
'Close the connection
oConn.Close
Set oConn = Nothing
Set oCmd = Nothing
Set oRS = Nothing
End Sub
à bientôt