Afficher un message
Vieux 27/04/2003, 13h38   #4 (permalink)
STéphane
Guest
 
Messages: n/a
Par défaut Re: ADO , écrire dans un Classeur fermé

bonjour

et le lien google que j'ai cité ?
en tout cas, je viens de le reprendre et ça marche :


'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



Sub EcritDatas()
Dim Fich$, cell As Range

Fich = "C:\Documents and Settings\STephane\Bureau\mmm.xls" 'à adapter

'écrit dans le classeur fermé la valeur des cellules A1:A5
'du classeur actif
For Each cell In ActiveWorkbook.Sheets("Feuil2").Range("A1:A5")
SetExternalDatas Fich, "Feuil2", 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