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...
Sub Princ()
Dim Temp
Temp = RecupVal("C:\DOSSIER\", "Nomfichier.xlsx", "FeuilNomfichier", "A1:B100", "FeuilleActive")
End Sub
Function RecupVal(Chemin$, Nomfichier$, NomFeuille, Plage$, F As Worksheet)
With F.Range(Plage)
.Formula = "='" & Chemin & "[" & Nomfichier & "]" & NomFeuille & "'!" & Plage
.Value = .Value
RecupVal = .Value
End With
End Function
Sub exportDonneeDansCelluleClasseurFerme()
'Référencer la bibliothèque Microsoft ActiveX Data Objects x.x
Dim Cn As ADODB.Connection
Dim Cd As ADODB.Command
Dim Rst As ADODB.Recordset
Dim Fichier As String
Fichier = "F:\Téléchargements\Classeur1.xlsx"
Set Cn = New ADODB.Connection
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;"";"
Set Cd = New ADODB.Command
Cd.ActiveConnection = Cn
Cd.CommandText = "SELECT * FROM [Feuil1$G20:G20]"
Set Rst = New ADODB.Recordset
Rst.Open Cd, , adOpenKeyset, adLockOptimistic
Rst(0).Value = "Donnée test"
Rst.Update
Cn.Close
Set Cn = Nothing
Set Cd = Nothing
Set Rst = Nothing
End Sub
Sub AddLigneDansBaseXLSX()
'patricktoulon
Dim AdoC As Object, Lenom$, Leprenom$, Letel$, Fichier As String, Feuille As String, strSQL As String
Dim colonne$, strSQLdestination$, strSQLscriptdonnée$
Fichier = "C:\Users\patricktoulon\Desktop\destination.xlsx" 'chemin complet du fichier fermé
Feuille = "Feuil1" 'nom de la feuille dans le fichier fermé
colonne = "nom,prenom,Tel" '(nom des entetes de plage ou header de TS)dans le fichier fermé
'les données a mettre dans le fichier de destination
Lenom = "dudu2" 'donnée pour la colonne 1(ici en l'occurence la colonne ou se trouve"nom")
Leprenom = "duduche" 'donnée pour la colonne 2(ici en l'occurence la colonne ou se trouve"prenom")
Letel = "06 06 06 06 06" 'donnée pour la colonne 3(ici en l'occurence la colonne ou se trouve"Tel")
Set AdoC = CreateObject("ADODB.Connection") 'creation de l'object de connection
With AdoC
'string de connection de l'object AdoC(moteur fichier 2007 et +)
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
.Open 'ouverture de la connection
strSQLdestination = "INSERT INTO[" & Feuille & "$](" & colonne & ")" 'encodage du script de la destination de la requete
strSQLscriptdonnée = "VALUES('" & Join(Array(Lenom, Leprenom, Letel), "','") & "')" 'encodage des donnée dans le script de la requete
strSQL = strSQLdestination & strSQLscriptdonnée 'compile du string de la requete
Debug.Print strSQL 'juste pour voir le string de la requete
.Execute strSQL 'execution de la requete
.Close 'fermeture de la connection
End With
Set AdoC = Nothing 'destruction de l'object de connection
End Sub
Sub exportDonneeDansCelluleClasseurFerme()
'Référencer la bibliothèque Microsoft ActiveX Data Objects x.x
Dim Cn As ADODB.Connection
Dim Cd As ADODB.Command
Dim Rst As ADODB.Recordset
Dim Fichier As String
Fichier = "F:\Téléchargements\Classeur1.xlsx"
Set Cn = New ADODB.Connection
'Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;"";"
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;IMEX=1"";"
Set Cd = New ADODB.Command
Cd.ActiveConnection = Cn
Cd.CommandText = "SELECT * FROM [Feuil1$G20:G20]"
Set Rst = New ADODB.Recordset
Rst.Open Cd, , adOpenKeyset, adLockOptimistic
Rst(0).Value = "Donnée test"
Rst.Update
Cn.Close
Set Cn = Nothing
Set Cd = Nothing
Set Rst = Nothing
End Sub
Sub test()
Dim fichier$, Feuille$, cel$, valeur
fichier = "C:\Users\patricktoulon\Desktop\recepteur.xlsx"
Feuille = "Feuil1"
cel = "G30"
valeur = "taratata"
exportOneCel fichier, Feuille, cel, valeur
End Sub
Sub exportOneCel(ByVal fichier$, ByVal Feuille$, ByVal cel$, valeur)
'patricktoulon
Dim AdoC As Object, CMd As Object, Rst As Object
Set AdoC = CreateObject("ADODB.Connection") 'creation de l'object de connection
Set Rst = CreateObject("ADODB.Recordset") 'creation de l'object recordset
'ouverture de la connection
AdoC.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & fichier & ";" & "Extended Properties=""Excel 12.0;HDR=NO;"""
Set CMd = CreateObject("ADODB.Command") 'creation de l'object command de Adoc
CMd.ActiveConnection = AdoC
'commande à exécuter de AdoC
CMd.CommandText = "SELECT * FROM [" & Feuille & "$" & cel & ":" & cel & "]"
Rst.Open CMd, , 1, 3 'ouverture de la commande de AdoC dans le recordset
Rst(0) = valeur 'inscription de la valeur dans l'item 0 du recordset
Rst.Update 'update du recordset
'on peut tout lacher maintenant
AdoC.Close
Set AdoC = Nothing
Set CMd = Nothing
Set Rst = Nothing
End Sub