Option Explicit
Sub Test()
Dim Fichier As String
Dim Feuille As String
Dim Cellule As String
Dim Valeur As Variant
Fichier = "F:\Téléchargements\Classeur1.xlsx"
Feuille = "Feuil1"
Cellule = "G3"
Valeur = "Donnée XX"
Call ÉcrireDansCelluleClasseurFermé(Fichier, Feuille, Cellule, Valeur)
End Sub
'----------------------------------------------------------------------
'Permet d'écrire dans une cellule d'une feuille d'un classeur fermé.
'Attention ! La cellule cible doit être dans le UsedRange de la feuille
' ou être A1 si la feuille cible est vide.
'----------------------------------------------------------------------
Sub ÉcrireDansCelluleClasseurFermé(Fichier As String, Feuille As String, Cellule As String, Valeur As Variant)
Dim Cnx As Object
Dim Cmd As Object
Dim Rst As Object
Dim ErrNumber As Long
'Si pas de Reference "Microsoft ActiveX Data Objects x.x Library"
Const adOpenKeyset = 1
Const adLockOptimistic = 3
Set Cnx = CreateObject("ADODB.Connection")
Cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Fichier & ";" & "Extended Properties=""Excel 12.0;HDR=NO;"""
Set Cmd = CreateObject("ADODB.Command")
Cmd.ActiveConnection = Cnx
Cmd.CommandText = "SELECT * FROM [" & Feuille & "$" & Cellule & ":" & Cellule & "]"
Set Rst = CreateObject("ADODB.Recordset")
On Error Resume Next
Rst.Open Cmd, , adOpenKeyset, adLockOptimistic
ErrNumber = Err.Number
On Error GoTo 0
If ErrNumber = -2147467259 Then
MsgBox "La cellule <" & Cellule & "> est hors du UsedRange de la feuille <" & Feuille & "> du fichier <" & Fichier & "> " & _
"et ne peut donc être valorisée par cette fonction !"
Exit Sub
End If
Rst(0).Value = Valeur
Rst.Update
Cnx.Close
Set Cnx = Nothing
Set Cmd = Nothing
Set Rst = Nothing
End Sub