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

10 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
FFO
Salut à toi

Tu peux définir une variable ainsi :

Mavariable = Sheets("GAV").Range("A65535").End(xlup).row

et mettre à la place de "A7" :

"A" & Mavariable

ce qui donne la ligne de code :

(SetExternalDatas Fich, "GAV", "A" & Mavariable, "mise à jour du " & Now)

Celà devrait convenir

Dis moi !!!!!!
Avatar
Patrednef
Bonjour FFO

merci mais je pense que cela ne fonctionne pas, car la feuille "GAV"
est une feuille d'un classeur fermé
Il me semble donc qu'il n'est pas possible de définir cette variable
puisque le fichier SuiviMaj.xls est fermé.

je ne vois pas ou définir cette variable dans la proc dans ce cadre

je peux me troper et je reste attentif à vos remarques

Merci

Patrednef
Avatar
FFO
Rebonjour à toi

Ce fichier fermé a t'il été ouvert pendant la procédure ????
Si oui avant sa fermeture il faut récupérer Mavariable avant de le fermer
comme indiqué dans ma proposition
si non n'est il pas possible de l'ouvrir juste pour la récupérer et de le
refermer ????

Qu'en penses tu ????
Avatar
Patrednef
FFO à dit:
si non n'est il pas possible de l'ouvrir juste pour la récupérer et de
le
refermer ????

Merci pour ta proposition,

Et non il n'est pas possible de l'ouvrir mais en non visible.

Avez vous une autre proposition ou une autre solution

Merci

Patrednef
Avatar
FFO
Rebonjour à toi

Ce fichier si il existe doit à un moment ou à un autre être utilisé donc
ouvert
Il faudrait à sa fermeture mettre dans une de ces cellules (Par exemple
cellule A1 de l'onglet "GAV") la précieuse information (Le numéro de la ligne
de la 1° cellule vide de la colonne A)
Il sera facile d'aller la récupérer fichier fermé avec cette ligne de code :

Mavariable = ExecuteExcel4Macro("'C:Chemin[MonClasseur.xls]GAV'!" &
Range("A1").Address(ReferenceStyle:=xlR1C1))

Il faut actualiser :

'C:Chemin[MonClasseur.xls]GAV'!" & Range("A1")

du chemin, nom du classeur, nom de l'onglet, cellule qui contiendra
l'information

Ce qui permettrait d'utiliser la ligne de code ainsi :

(SetExternalDatas Fich, "GAV", "A" & Mavariable, "mise à jour du " & Now)

Pour obtenir le numéro de la ligne de la 1° cellule vide colonne A dans
l'onglet "GAV" tu peux mettre dans la cellule dédiée à cette information
cette formule :

=NBVAL(GAV!A:A)+1

Attention il faut que toutes les celulles soit non vides jusqu'à la première
cellule vide de cette colonne

Peut être ta solution

Dis moi !!!!!
Avatar
JB
Bonjour,

'Nombre de lignes de la colonne A
repertoire = ThisWorkbook.Path & ""
Set cnn = New ADODB.Connection
cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" &
_
repertoire & "ADOsource.xls"
Set rs = cnn.Execute("SELECT count(*) as NbLignes FROM
[Feuil1$A1:A1000]")
x = rs("nbLignes")
MsgBox x
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing

JB


On 27 nov, 12:16, Patrednef wrote:
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édures diverses et variées

 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ère cellule vide de la colonne "A"
à la place du "A7"

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

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

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

Je vous remercie d'avance pour vos lumières, bien utiles ..

Je reste à votre écoute et vous trouverez ci dessous les 2 sub

Patrednef

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

  Fich = "C:UsersDDSPDocumentsSuiviMaj.xls"

  'Open the ADO connection to the Excel workbook
    Set oConn = New ADODB.Connection
    oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
               "Data Source=" & Fich & ";" & _
               "Extended Properties=""Excel 8.0;HDR=Y ES;IMEX=2;"""

    'Add values to individual cells
   SetExternalDatas Fich, "GAV", "A7", "mise à 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è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 & "$" & RangeDes t
& "`"

On Error Resume Next
  ' 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


Avatar
JB
Nom Prenom Salaire
Dupont Jean 6000
Martin Daniel 7000

Sub AjoutEnregistrement()
repertoire = ThisWorkbook.Path & ""
Set cnn = New ADODB.Connection
fichier = repertoire & "ADOsource.xls"
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" &
fichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;IMEX=2;"""
Set rs = New ADODB.Recordset
rs.Open "SELECT * from [Feuil1$A1:C1000]", cnn, adOpenDynamic,
adLockOptimistic
rs.AddNew
rs(0).Value = "xxxx"
rs(1).Value = "yyyy"
rs.Update
rs.Close
cnn.Close
End Sub

JB

On 27 nov, 16:45, JB wrote:
Bonjour,

'Nombre de lignes de la colonne A
  repertoire = ThisWorkbook.Path & ""
  Set cnn = New ADODB.Connection
  cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ =" &
_
      repertoire & "ADOsource.xls"
  Set rs = cnn.Execute("SELECT count(*) as NbLignes FROM
[Feuil1$A1:A1000]")
  x = rs("nbLignes")
  MsgBox x
  rs.Close
  cnn.Close
  Set rs = Nothing
  Set cnn = Nothing

JB

On 27 nov, 12:16, Patrednef wrote:



> 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édures diverses et variées

>  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ère cellule vide de la colonne "A"
> à la place du "A7"

> (SetExternalDatas Fich, "GAV", "A7", "mise à jour du " & Now)

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

> Je n'arrive pas à comprendre a quel moment on pourrait le
> calculer ....le variabiliser .....

> Je vous remercie d'avance pour vos lumières, bien utiles ..

> Je reste à votre écoute et vous trouverez ci dessous les 2 sub

> Patrednef

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

>   Fich = "C:UsersDDSPDocumentsSuiviMaj.xls"

>   'Open the ADO connection to the Excel workbook
>     Set oConn = New ADODB.Connection
>     oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
>                "Data Source=" & Fich & ";" & _
>                "Extended Properties=""Excel 8.0;HDR =YES;IMEX=2;"""

>     'Add values to individual cells
>    SetExternalDatas Fich, "GAV", "A7", "mise à 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è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 & "$" & RangeD est
> & "`"

> On Error Resume Next
>   ' 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- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -


Avatar
michdenis
Bonjour,

Tu places tout ce qui suit dans un module standard :

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

Dim Fich As String, cell As Range
Dim DerCel As Long, Feuille As String
Dim NomFeuille As String, Colonne As String

'**** Variable à renseigner************
NomFeuille = "Feuil1"
Colonne = "A:A"
Fich = "C:Test.xls"
'**************************************

Feuille = "[" & NomFeuille & "$" & Colonne & "]"
DerCel = GetLastRow(Fich, Feuille)
SetExternalDatas Fich, NomFeuille, "A" & DerCel, _
"mise à jour du " & Now
'Si requis
'Workbooks.Open Fich
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"""

'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 GetLastRow(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
GetLastRow = Rst.AbsolutePosition + 1
Rst.Close: Conn.Close
Set Conn = Nothing: Set Rst = Nothing
End Function
'----------------------------------------------
Avatar
Patrednef
Bonsoir,

Merci a FFo et à JB, les 2 solutions fonctionnent:

FFO: ta solution Ok mais il faut que le fichier ou l'on veut écrire
est une cellule en dur avec le résultat de NB ..... ce qui ajoute une
ligne de code sur chaque fichier à traiter.
Mais cela fonctionne

JB: Cette solution me convient mieux, on garde la variabilité des
fichiers ou écrire, on ne doit pas akouter une ligne de code dans les
fichiers ou il faudrait écrire
Seule petite modification trouvée, le MsgBox x donne le nombre de
cellules pleines - 1 (base 0 ?)

Pour le nombre total de cellules non vides en colonne A il faut donc
faire x+1
Et pour le numéro de ligne de la première vide, c'est x +2

je vous remercie et je vais donc utiliser le code de JB pour finaliser
cela

Bravo à nouveau pour vos performances, votre savoir, et votre volonté
de partager vos connaissances en nous aidant un peu à grandir dans ce
monde du VBA .........un grand merci

PatRednef
Avatar
Patrednef
Merci MichDenis,

La chance est avec moi, les roi du forum me conseille ...

J'ai une erreur sur la ligne:

Rst.Open TableName, Conn, adOpenStatic de la fonction Function
GetLastRow ...
J'ai active x 2.8 activé pourtant

Pouvez vous me donner votre avis, cette solution semble très
intéressante

A de suite

PatRednef
1 2