Sujet Précédent Sujet Suivant

Export vers Excel

Résolu/Fermé
Lenouveauapprenti Messages postés 300 Date d'inscription samedi 22 décembre 2018 Statut Membre Dernière intervention 7 avril 2024 - Modifié le 15 juil. 2019 à 20:08
Lenouveauapprenti Messages postés 300 Date d'inscription samedi 22 décembre 2018 Statut Membre Dernière intervention 7 avril 2024 - 18 juil. 2019 à 16:59
Bonjour

Note préalable : Je travaille dans l'environnement de VB6 avec Access.

J'ai Une Table en Access (Base de données ) qui contient 720 lignes (Enregistrements), que je faisais afficher sur une DataGrid (DGPlanCptable), avec 18 lignes et une barre de défilement ( vers : Haut et Bas ).
Quand je défile les enregistrements affichés je trouve les 720 lignes.

Mon problème : Lors de la pression de la commande ( Exporter ), l'exportation ne me réussissait pas quand le nombre de lignes dépasse 18, capacité d'affichage de ma DataGrid (DGPlanCptable) selon sa largeur (Height).

Merci de corriger mon code cité ci-dessous pour pouvoir exporter tout le contenu de ma Table en Access (TablePlanComptable), dans la Base de Données .

Mon code est comme suite : 



Private Sub CmdExporter_Click()

Dim xlo As Object
Dim I, J, L, k As Integer


On Error GoTo errxcel:



Set xlo = CreateObject("Excel.application")


I = RS.RecordCount
RS.MoveFirst


DoEvents

xlo.Visible = True
xlo.Workbooks.Add


J = DGPlanCptable.Columns.Count

For k = 0 To J - 1

xlo.Workbooks(1).Sheets(1).Cells(L + 1, k + 1) = DGPlanCptable.Columns(k).Caption


Next k

I = 0
RS.MoveFirst

Do While Not RS.EOF

For k = 0 To k - 1

DGPlanCptable.Col = k
DGPlanCptable.Row = I

xlo.Workbooks(1).Sheets(1).Cells(I + 2, k + 1) = DGPlanCptable.Text


Next

RS.MoveNext

I = I + 1

Loop

Exit Sub

errxcel:


MsgBox "Aucune feuuille Excel n'est trouvée", vbCritical + vbInformation, "Info !"



End Sub
A voir également:

2 réponses

Réponse 1 / 2
f894009 Messages postés 17205 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 octobre 2024 1 709
16 juil. 2019 à 07:31
Bonjour,

Soit passer par une commande Access ou par ADO
A voir pour ADO
https://docs.microsoft.com/fr-fr/office/troubleshoot/excel/transfer-data-to-excel-from-vb
0
Lenouveauapprenti Messages postés 300 Date d'inscription samedi 22 décembre 2018 Statut Membre Dernière intervention 7 avril 2024 2
16 juil. 2019 à 14:09
Bonjour

Merci pour m'avoir orienté vers ce support. Mon problème est résolu.
Je vous remets mon code après une légère adaptation à mon besoin.

Par ailleurs, il y'a Deux Observations, lesquelles puevent êtres corrigées manuellement.

1 La copie des données se faisait d'une façon aléatoire ( Déclassée)
2 L ' entête de la Table ne s'affiche pas 



Private Sub CmdExporter_Click()


'Create a Recordset from all the records in the Orders table
   Dim sNWind As String
   Dim conn As New ADODB.Connection
   
   sNWind = _
      "C:\Compta\BDCompta.mdb"
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
      sNWind & ";"
   conn.CursorLocation = adUseClient
   Set RS = conn.Execute("TablePlanComptable", , adCmdTable)
   
   'Create a new workbook in Excel
   Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add
   Set oSheet = oBook.Worksheets(1)
   
   'Transfer the data to Excel
   oSheet.Range("A1").CopyFromRecordset RS
   
   'Save the Workbook and Quit Excel
   
   On Error GoTo nnn:
   
   CmnDialog.ShowOpen
      
    
   
    'oBook.SaveAs "C:\Book1.xls"
    oExcel.Quit
   
   'Close the connection
   RS.Close
   conn.Close
   
   Unload Me
   
nnn:


end sub
0
f894009 Messages postés 17205 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 octobre 2024 1 709
16 juil. 2019 à 17:01
Re,

1 La copie des données se faisait d'une façon aléatoire ( Déclassée)
Pouvez expliquer un peu plus….

2 L'entête de la Table ne s'affiche pas
Tout a fait normal Thierry, car vous n'avez que les donnees dans un recordset.
Vous devez ecrire les entetes
0
Lenouveauapprenti Messages postés 300 Date d'inscription samedi 22 décembre 2018 Statut Membre Dernière intervention 7 avril 2024 2
16 juil. 2019 à 17:05
Re

Comme je vous le disais, Ces Deux observations sont corrigeables manuellement.
Je voulais dire par ( déclassée), le transfert des données de la BD vers Excel ne respecte pas l'ordre de l'enregistrement dans la BD. Ce n'est pas grave.
0
f894009 Messages postés 17205 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 octobre 2024 1 709
16 juil. 2019 à 17:17
Re,
Utilsez une requete sql avec un order by du champ qui est suppose enregistre dans l'ordre plutôt que ceci 
Set RS = conn.Execute("TablePlanComptable", , adCmdTable)
0
Lenouveauapprenti Messages postés 300 Date d'inscription samedi 22 décembre 2018 Statut Membre Dernière intervention 7 avril 2024 2
Modifié le 16 juil. 2019 à 19:53
Re

Avec toute ma reconnaissance.

Via la requête SQL avec Order by le transfert a bien réussi dans l'ordre des enregistrements.
Suite de quoi le code est devenu comme suite: 


Private Sub CmdExporter_Click()


'Create a Recordset from all the records in the Orders table
   Dim sNWind As String
   Dim conn As New ADODB.Connection
   
   sNWind = _
      "C:\Compta\BDCompta.mdb"
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
      sNWind & ";"
   conn.CursorLocation = adUseClient
   'Set RS = conn.Execute("TablePlanComptable", , adCmdTable)
   
   SQLs = "select * from TablePlanComptable where (Societe='" & CStr(VarSociete) & "')" & "order by Compte asc"
    
   If RS.State = adStateOpen Then RS.Close
   RS.Open SQLs, DB, adOpenKeyset, adLockPessimistic
   
   
   
   'Create a new workbook in Excel
   Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add
   Set oSheet = oBook.Worksheets(1)
   
   'Transfer the data to Excel
   oSheet.Range("A1").CopyFromRecordset RS
   
   'Save the Workbook and Quit Excel
   
   On Error GoTo nnn:
   
   CmnDialog.ShowOpen
      
    
   
    'oBook.SaveAs "C:\Book1.xls"
    oExcel.Quit
   
   'Close the connection
   RS.Close
   conn.Close
   
   Unload Me
   
nnn:
   
End Sub
0
Réponse 2 / 2
f894009 Messages postés 17205 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 octobre 2024 1 709
18 juil. 2019 à 16:41
Re,
En effet, c'est moi qui suit passe a cote
Ok, pour ce code
0

Discussions similaires

Colis en cours de transport vers votre site de livraison ?
Ninan_5568 -
JulieVdr -

7 réponses