Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel ADO, écriture fichier fermé et plage variable ..... help please

ADO, écriture fichier fermé et plage variable ..... help please

14 réponses
Avatar
Patrednef
Bonjour aux gentils contributeurs de ce forum,

J'utilise ce forum ainsi que les incontournables sites d'excelabo, FS
et JB en autres ....

De ces auteurs (qui sont des stars pour nous !!! et que l'on ne les
voit jamais dans la presse people)
j'ai pu obtenir des proc=E9dures diverses et vari=E9es

En voici 2 et je me pose la question suivante

J'aimerai dans la sub ExportData au moment d'ajouter les infos dans la
feuille "GAV" transformer le 3eme parametre de la Sub SetExternalDatas
(DestCellAdr As String) en plage variable du style:
La premi=E8re cellule vide de la colonne "A"
=E0 la place du "A7"

(SetExternalDatas Fich, "GAV", "A7", "mise =E0 jour du " & Now)

Cela est il possible ? quelle en est alors la synthaxe ???

Je n'arrive pas =E0 comprendre a quel moment on pourrait le
calculer ....le variabiliser .....

Je vous remercie d'avance pour vos lumi=E8res, bien utiles ..

Je reste =E0 votre =E9coute et vous trouverez ci dessous les 2 sub

Patrednef

Sub ExportData()
Dim Fich As String, cell As Range

Fich =3D "C:\Users\DDSP\Documents\SuiviMaj.xls"

'Open the ADO connection to the Excel workbook
Set oConn =3D New ADODB.Connection
oConn.Open "Provider=3DMicrosoft.Jet.OLEDB.4.0;" & _
"Data Source=3D" & Fich & ";" & _
"Extended Properties=3D""Excel 8.0;HDR=3DYES;IMEX=3D2;"""

'Add values to individual cells
SetExternalDatas Fich, "GAV", "A7", "mise =E0 jour du " & Now

'Close the connection
oConn.Close

'Open the workbook to examine the results
DoEvents
Workbooks.Open Fich 'enlever cela si on ne veut pas ouvrir le
fichier
End Sub
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=E8s Rob Bovey, mpep

' Open a connection to the Excel spreadsheet
Set oConn =3D New ADODB.Connection
oConn.Open "Provider=3DMicrosoft.Jet.OLEDB.4.0;" & _
"Data Source=3D" & DestFile & ";" & _
"Extended Properties=3D""Excel 8.0;HDR=3DNo;"";"

' Create a command object and set its ActiveConnection
Set oCmd =3D New ADODB.Command
oCmd.ActiveConnection =3D oConn

' This SQL statement selects a cell range in the "feuilleTest"
worksheet.
'1 S=E9lection pour =E9crire dans une seule cellule
RangeDest =3D DestCellAdr & ":" & DestCellAdr
oCmd.CommandText =3D "SELECT * from `" & DestFeuille & "$" & RangeDest
& "`"

On Error Resume Next
' Open a recordset containing the worksheet data.
Set oRS =3D New ADODB.Recordset
oRS.Open oCmd, , adOpenKeyset, adLockOptimistic

' Update last row
oRS(0).Value =3D DataToWrite
oRS.Update

'Close the connection
oConn.Close
Set oConn =3D Nothing
Set oCmd =3D Nothing
Set oRS =3D Nothing
End Sub
Signaler un problème avec ce contenu

4 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Patrednef
Une précision..... l'erreur est:

Instruction SQL non valide...............

Bonne soirée et merci beaucoup pour le coup de main

PatRednef
Avatar
michdenis
Voici une version légèrement modifiée dans sa présentation pour
faciliter le renseignement des variables :

A ) Cette procédure requiert l'ajout de la bibliothèque
"Microsoft Activex Data Object 2.8 Librairy"
Pour ce faire, dans la fenêtre de l'éditeur de code d'Excel
Barre des menus / outils / références / et
cocher la référence indiquée

B ) Si l'on désire que la donnée soit ajoutée au format voulu,
le plus simple est d'attribuer à la colonne du fichier cible
le format désiré : Format numérique, Date avant l'exécution
de la procédure sinon, l'affichage de la nouvelle de donnée se
fera à gauche dans la cellule de destination, il y faudra ajouter
une petite procédure au fichier cible pour permettre un affichage
adéquat à l'ouverture de ce dernier !

C ) En renseignant les 4 variables de la procédure "ExportData()",
Cette procédure ajoute à la ligne suivant la dernière ligne
occupée de la colonne désignée, le contenu de la variable
"LaDonnée" dans le fichier et la feuille spécifiée du classeur
fermé ou ouvert.

'------------------------------------------------------
Sub ExportData()

Dim Fichier As String, cell As Range
Dim DerCel As Long, Feuille As String
Dim NomFeuille As String, Col As String
Dim LaDonnée As Variant

'*********** Variable à renseigner**************
Fichier = "C:Test.xls" 'Fichier de destination
NomFeuille = "Feuil1" 'Du fichier de destination
Col = "G" 'Lettre représentant la colonne
LaDonnée = Now() 'la donnée à ajouter
'************************************************

Feuille = "[" & NomFeuille & "$" & Col & ":" & Col & "]"
DerCel = GetLastRow1(Fichier, Feuille)
SetExternalDatas Fichier, NomFeuille, Col & DerCel, LaDonnée

'Si requis ouverture du fichier cible
'Workbooks.Open Fichier
End Sub

'------------------------------------------------------
Sub SetExternalDatas(DestFile As String, _
DestFeuille As String, _
DestCellAdr As String, _
DataToWrite As Variant)
Dim Conn As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Requete As String
Dim RangeDest

Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & DestFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=NO;IMEX=2"""

'1 Sélection pour écrire dans une seule cellule
RangeDest = DestCellAdr & ":" & DestCellAdr

Requete = "SELECT * from [" & DestFeuille & "$" & RangeDest & "]"
Rst.Open Requete, Conn, adOpenKeyset, adLockOptimistic

' Mise à jour dernière entrée de donnée
Rst(0).Value = DataToWrite
Rst.Update

'Fermeture de la connection et recordset
Rst.Close: Conn.Close
Set Conn = Nothing
Set Rst = Nothing
End Sub

'------------------------------------------------------
Function GetLastRow1(ByVal Fname As String, _
ByVal TableName As String) As Long
'Fname est le nom du chemin et fichier complet
'TableName est le nom de la feuille
Dim Flawed As Boolean, i As Long
Dim Conn As ADODB.Connection, Rst As ADODB.Recordset

Set Conn = New ADODB.Connection

Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fname & ";" & _
"Extended Properties=""Excel 8.0;HDR=NO;IMEX=1"""

Set Rst = New ADODB.Recordset
Rst.CursorLocation = adUseClient
Rst.Open TableName, Conn, adOpenStatic
Rst.MoveLast

Flawed = True
Do While (Flawed)
For i = 0 To Rst.Fields.Count - 1
If Not IsNull(Rst.Fields(i).Value) Then
Flawed = False
Exit Do
End If
Next
Rst.MovePrevious
Loop
GetLastRow1 = Rst.AbsolutePosition + 1
Rst.Close: Conn.Close
Set Conn = Nothing: Set Rst = Nothing
End Function
'------------------------------------------------------





"Patrednef" a écrit dans le message de groupe de discussion :

Une précision..... l'erreur est:

Instruction SQL non valide...............

Bonne soirée et merci beaucoup pour le coup de main

PatRednef
Avatar
Patrednef
Bonjour michdenis,

Ta solution est parfaitement adaptée au problème, elle fonctionne
parfaitement, je vais la décortiquer pour essayer de tout comprendre,
mais c'est parfait, et la partie renseignement de variable est au plus
simple

faut il prévoir d'ajouter une gestion d'erreur, le nom de la feuille
est renseigné par moi même, donc pas de modif, la seule erreur
pourrait etre la disparition du fichier ou de son déplacement, mais je
vais ajouter un petit test pour cela

merci encore pour cette procédure qui est parfaite, j'ai fait
plusieurs tests, et même pas reussit à trouver un petit bug.....

Bravo, tes posts sont toujours très pédagogique

Au plaisir et merci à vous tous de votre générosité

PatRednef
Avatar
michdenis
| la seule erreur pourrait etre la disparition du fichier
| ou de son déplacement, mais je vais ajouter un petit
| test pour cela

If dir("c:Test.xls") = "" then
Msgbox "Fichier introuvable"
exit sub
end if




"Patrednef" a écrit dans le message de groupe de discussion :

Bonjour michdenis,

Ta solution est parfaitement adaptée au problème, elle fonctionne
parfaitement, je vais la décortiquer pour essayer de tout comprendre,
mais c'est parfait, et la partie renseignement de variable est au plus
simple

faut il prévoir d'ajouter une gestion d'erreur, le nom de la feuille
est renseigné par moi même, donc pas de modif, la seule erreur
pourrait etre la disparition du fichier ou de son déplacement, mais je
vais ajouter un petit test pour cela

merci encore pour cette procédure qui est parfaite, j'ai fait
plusieurs tests, et même pas reussit à trouver un petit bug.....

Bravo, tes posts sont toujours très pédagogique

Au plaisir et merci à vous tous de votre générosité

PatRednef
1 2