Discussion :

[MatAir]

Bonjour,
Je voudrais créer une routine qui combinerais plusieurs tables dans un seul fichier excel de plusieurs feuilles.
J'ai retrouvé ce code que je tente de modifier pour mes besoins.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 
Public Sub ExportTable()
 
   ' déclaration des variables
   Dim tabListe() As String             ' tableau où on va stocker la liste des tables
   Dim xlApp As Excel.Application       ' ne pas oublier de cocher la référence Excel
   Dim xlBook As Excel.Workbook         ' le classeur où se trouve la feuille
   Dim xlSheet As Excel.Worksheet       ' la feuille où on va stocker les tables
   Dim db As DAO.Database              ' nous utilisons la bibilothèque DAO
   Dim rst As DAO.Recordset             ' le recordset pour récupérer les données des tables
   Dim i As Integer                     ' pour boucler sur les tables
   Dim lngNbrLigne As Long
 
   Set db = CurrentDb
 
   ' on rempli le tableau avec 3 tables
   ReDim tabListe(4)
   tabListe(0) = "Table1"
   tabListe(1) = "Table2"
   tabListe(2) = "Table3"
   tabListe(3) = "Table4"
 
   ' on ouvre notre classeur Excel
   Set xlApp = CreateObject("Excel.Application")
   Set xlBook = xlApp.Workbooks.Open("C:\Users\Philippe\Desktop\Peinture.xls")
   Set xlSheet = xlBook.Worksheets("Feuil2") 'ici on va stocker dans la deuxième feuille du classeur Peinture
 
   ' bouclage sur les tables pour remplir la feuille
   For i = 0 To UBound(tabListe()) - 1
        Set rst = db.OpenRecordset("SELECT * FROM " & tabListe(i) & ";")
        If i = 0 Then ' si c'est la première table
            lngNbrLigne = rst.RecordCount + 1
            xlSheet.Range("A1").CopyFromRecordset rst
        Else
            xlSheet.Range("A" & lngNbrLigne).CopyFromRecordset rst
            lngNbrLigne = lngNbrLigne + rst.RecordCount
        End If
        Set rst = Nothing
   Next i
 
   ' libération des objets
 
 
   xlBook.Save
   xlApp.Quit
   Set xlSheet = Nothing
   Set xlBook = Nothing
   Set xlApp = Nothing
 
   MsgBox "Fin de traitement"
End Sub

Voici mes modifications:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
   ' on rempli le tableau avec 8 tables
   ReDim tabListe(8)
   tabListe(0) = "intervention chaussée"
   tabListe(1) = "Béton"
   tabListe(2) = "ActConn"
   tabListe(3) = "Autres éléments"
   tabListe(4) = "Bretelle"
   tabListe(5) = "Gravier"
   tabListe(6) = "Parachèvement 3 ans total"
   tabListe(7) = "Ponceau"
 
 ' on ouvre notre classeur Excel
   Set xlApp = CreateObject("Excel.Application")
   Set xlBook = xlApp.Workbooks.Add
 ' création des 8 feuilles du nouveau classeur
   Set xlSheet = xlBook.Worksheets.Add 'ici on va stocker dans la deuxième feuille du classeur Peinture
   xlSheet.Name = "Intervention chaussée"
 
' bouclage sur les tables pour remplir la feuille
   For i = 0 To UBound(tabListe()) - 1
        Set rst = db.OpenRecordset("SELECT * FROM " & tabListe(i) & ";")
        If i = 0 Then ' si c'est la première table
            lngNbrLigne = rst.RecordCount + 1
            xlSheet.Range("A1").CopyFromRecordset rst
        Else
            xlSheet.Range("A" & lngNbrLigne).CopyFromRecordset rst
            lngNbrLigne = lngNbrLigne + rst.RecordCount
        End If
        Set rst = Nothing

J'ai 3 questions:

1. - Est-ce possible de faire une boucle qui utiliserait le nom des 8 tables que je viens de copier dans mon tableau afin de nommée les feuilles excel que j'ai créé( Est ce que ce tableau contient toute la table ou seulement le nom de la table)

2. - Si j'ai bien compris, la boucle copie toute les tables sur la même feuille, je voudrais que chaque table soit copié sur des feuilles distinctes

3. - Comme j'ai créé mon fichier excel je dois surement modifier la libération de l'objet xlBook.save (voir la fin du 1er bloc de code)

J'espère avoir été suffisamment clair
merci d'avance

[MatAir]

Rebonjour

j'ai intégré la création de mes feuilles excel dans la boucle de copie tel que montré dans le code suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 
Public Sub ExportTable()
 
   ' déclaration des variables
   Dim tabListe() As String             ' tableau où on va stocker la liste des tables
   Dim xlApp As Excel.Application       ' ne pas oublier de cocher la référence Excel
   Dim xlBook As Excel.Workbook         ' le classeur où se trouve la feuille
   Dim xlSheet As Excel.Worksheet       ' la feuille où on va stocker les tables
   Dim db As DAO.Database              ' nous utilisons la bibilothèque DAO
   Dim rst As DAO.Recordset             ' le recordset pour récupérer les données des tables
   Dim i As Integer                     ' pour boucler sur les tables
   Dim mon_path_destination As String
 
 
   Set db = CurrentDb
 
   ' on rempli le tableau avec 8 tables
   ReDim tabListe(8)
 
    tabListe(0) = "Béton"
    tabListe(1) = "Intervention_chaussée"
    tabListe(2) = "Ponceau"
    tabListe(3) = "ActConn"
    tabListe(4) = "Bretelle"
    tabListe(5) = "Gravier"
    tabListe(6) = "Autres_éléments"
    tabListe(7) = "Parachèvement_3_ans_total"
 
   ' on créé notre classeur Excel
   Set xlApp = CreateObject("Excel.Application")
   Set xlBook = xlApp.Workbooks.Add
 
   ' bouclage sur les tables pour remplir la feuille
   For i = 0 To UBound(tabListe()) - 1
 
        Set xlSheet = xlBook.Worksheets.Add
        xlSheet.Name = tabListe(i)
        Set rst = db.OpenRecordset("SELECT * FROM " & tabListe(i) & ";")
        xlSheet.Range("A2").CopyFromRecordset rst
 
        Set rst = Nothing
   Next i
 
   MsgBox "Fin de traitement - Enregistré votre fichier Excel"
  ' mon_path_destination = xlBook.GetSaveAsFilenam(InitialFilename:="Resultat")
   'xlBook.ActiveProject.SaveAs (mon_path_destination)
 
   ' libération des objets
   xlBook.Save
   xlApp.Quit
   Set xlSheet = Nothing
   Set xlBook = Nothing
   Set xlApp = Nothing
 
End Sub

1er problème l'enregistrement ne se fait pas. Les 2 lignes en commentaire ne fonctionne pas et comme jme doutais xlbook.save enregistre le fichier a un endroit mystère.

2e problème, l'appel de la fonction, j'ai testé la fonction seul mais je suis incapable de l'appeller à l'intérieur du code principale. Est-ce que j'ai besoin de lui fournir des arguments???

votre aide est tjrs apprécié
merci

[MatAir]

J'ai réglé mon premier problème, il ne reste que le 2e

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Public Sub ExportTable()
 
   ' déclaration des variables
   Dim tabListe() As String             ' tableau où on va stocker la liste des tables
   Dim xlApp As Excel.Application       ' ne pas oublier de cocher la référence Excel
   Dim xlBook As Excel.Workbook         ' le classeur où se trouve la feuille
   Dim xlSheet As Excel.Worksheet       ' la feuille où on va stocker les tables
   Dim db As DAO.Database              ' nous utilisons la bibilothèque DAO
   Dim rst As DAO.Recordset             ' le recordset pour récupérer les données des tables
   Dim i As Integer                     ' pour boucler sur les tables
   Dim j As Integer
 
 
   Set db = CurrentDb
 
   ' on rempli le tableau avec 8 tables
   ReDim tabListe(8)
 
    tabListe(0) = "Béton"
    tabListe(1) = "Intervention_chaussée"
    tabListe(2) = "Ponceau"
    tabListe(3) = "ActConn"
    tabListe(4) = "Bretelle"
    tabListe(5) = "Gravier"
    tabListe(6) = "Autres_éléments"
    tabListe(7) = "Parachèvement_3_ans_total"
 
   ' on créé notre classeur Excel
   Set xlApp = CreateObject("Excel.Application")
   Set xlBook = xlApp.Workbooks.Add
 
   ' bouclage sur les tables pour remplir la feuille
   For i = 0 To UBound(tabListe()) - 1
 
        Set xlSheet = xlBook.Worksheets.Add
        xlSheet.Name = tabListe(i)
            ' les entetes
            '  .Fields(Index).Name renvoie le nom du champ
 
            Set rst = CurrentDb.OpenRecordset(tabListe(i), dbOpenSnapshot)
 
            For j = 0 To rst.Fields.Count - 1
                xlSheet.Cells(1, j + 1) = rst.Fields(j).Name
                    ' Nous appliquons des enrichissements de format aux cellules
                     With xlSheet.Cells(1, j + 1)
                    .Interior.ColorIndex = 15
                    .Interior.Pattern = xlSolid
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThin
                    .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
                    .HorizontalAlignment = xlCenter
                    End With
             Next j
 
 
        Set rst = db.OpenRecordset("SELECT * FROM " & tabListe(i) & ";")
        xlSheet.Range("A2").CopyFromRecordset rst
 
        Set rst = Nothing
   Next i
 
   MsgBox "Fin de traitement -  votre fichier Excel a été enregistré dans le dossier rapport"
    xlBook.SaveAs CurrentProject.Path & "\Rapport\rapport.xls"
 
   ' libération des objets
   'xlBook.Save
   xlApp.Quit
   Set xlSheet = Nothing
   Set xlBook = Nothing
   Set xlApp = Nothing
 
End Sub

Je suis certain que c'est quelque chose de simple mais je trouve pas!!
merci