Piloter Excel depuis Access : apprendre les bonnes pratiques

Un billet de blog de Denis Hulo

1
2
3
4
5
6
    Dim xlapp As Excel.Application ' variable Objet pour faire référence à l'application Excel
    Dim xlwbk As Excel.Workbook ' variable Objet pour faire référence au classeur
    Dim xlwsh As Excel.Worksheet ' variable Objet pour faire référence à la feuille
 
    Dim dbs As DAO.Database ' variable pour faire référence à la base courante
    Dim rst As DAO.Recordset ' variable pour faire référence au recordset lié à la table Access

1
2
3
4
5
6
7
8
9
10
    On Error GoTo err_ExportData
    ...
    ...
err_ExportData:
 
    If Err.Number <> 0 Then ' si une erreur s'est produite
        MsgBox (Err.Description) ' affiche une description de l'erreur
    End If
 
    ' On libère les variables objet ici

1
2
3
4
5
6
    On Error Resume Next ' instruction pour ignorer l'erreur qui pourrait se déclencher sur la ligne suivante
    Set xlapp = GetObject(, "Excel.Application") ' on récupère l'instance Excel ouverte : si pas d'instance la variable est à nothing
    On Error GoTo err_ExportData ' reprend la gestion d'erreur normale en annulant l'effet de l'instruction On error resume next
    If xlapp Is Nothing Then ' si pas d'instance d'Excel de créée
        Set xlapp = CreateObject("Excel.Application") ' on crée une nouvelle instance
    End If

1
2
3
4
5
6
7
    On Error Resume Next ' instruction pour ignorer l'erreur qui pourrait se déclencher sur la ligne suivante
    Set xlwbk = xlapp.Workbooks.Item(ExtractFileName(cheminFichierDestination)) ' on récupère l'instance du classeur ouvert : si pas d'instance la variable est à nothing
    On Error GoTo err_ExportData ' reprend la gestion d'erreur normale en annulant l'effet de l'instruction On error resume next
 
    If xlwbk Is Nothing Then ' si pas d'instance du classeur de déjà créée
        Set xlwbk = xlapp.Workbooks.Open(cheminFichierDestination) ' on crée une nouvelle instance
    End If

1
2
3
    xlapp.Calculation = xlCalculationManual ' désactive les calculs automatiques sur le classeur
    xlapp.ScreenUpdating = False ' désactive le rafraîchissement automatique de l'écran
    xlapp.EnableEvents = False ' désactive les événements

1
2
3
    xlapp.ScreenUpdating = True ' active le rafraîchissement automatique de l'écran
    xlapp.EnableEvents = True ' active les événements
    xlapp.Calculation = xlCalculationAutomatic ' active les calculs automatiques des formules

1
2
3
4
5
6
7
8
9
10
11
 ' libère et ferme les variables objet
    Set rst = Nothing
    Set dbs = Nothing
 
    Set xlwsh = Nothing
 
    xlwbk.Close True ' on ferme avec sauvegarde du classeur
    Set xlwbk = Nothing
 
    xlapp.Quit ' quitte Excel
    Set xlapp = Nothing

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
Public Sub ExportData(dataSource As String, cheminFichierDestination As String, nomFeuille As String, Optional ajout As Boolean = False)
    ' Procédure d'exportation des données de la source, dans le fichier et la feuille passés en arguments
    On Error GoTo err_ExportData
 
    Dim xlapp As Excel.Application ' variable Objet pour faire référence à l'application Excel
    Dim xlwbk As Excel.Workbook ' variable Objet pour faire référence au classeur
    Dim xlwsh As Excel.Worksheet ' variable Objet pour faire référence à la feuille
 
    Dim dbs As DAO.Database ' variable pour faire référence à la base courante
    Dim rst As DAO.Recordset ' variable pour faire référence au recordset lié à la table Access
 
    Dim idLigne As Long, idColonne As Long, idligneMax As Long, idColonneMax As Long
 
    If MsgBox("Souhaitez-vous exporter les données dans le fichier Excel ?", vbYesNo) = vbNo Then
        Exit Sub
    End If
 
    If Not IsFile(cheminFichierDestination) Then ' si le fichier n'existe pas on sort
        MsgBox "Fichier introuvable !", vbExclamation ' on signale que le fichier est introuvable
        Exit Sub ' on sort de la procédure
    End If
 
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(dataSource)
 
    On Error Resume Next ' instruction pour ignorer l'erreur qui pourrait se déclencher sur la ligne suivante
    Set xlapp = GetObject(, "Excel.Application") ' on récupère l'instance Excel ouverte : si pas d'instance la variable est à nothing
    On Error GoTo err_ExportData ' reprend la gestion d'erreur normale en annulant l'effet de l'instruction On error resume next
 
    If xlapp Is Nothing Then ' si pas d'instance d'Excel de créée
        Set xlapp = CreateObject("Excel.Application") ' on crée une nouvelle instance
    End If
 
    On Error Resume Next ' instruction pour ignorer l'erreur qui pourrait se déclencher sur la ligne suivante
    Set xlwbk = xlapp.Workbooks.Item(ExtractFileName(cheminFichierDestination)) ' on récupère l'instance du classeur ouvert : si pas d'instance la variable est à nothing
    On Error GoTo err_ExportData ' reprend la gestion d'erreur normale en annulant l'effet de l'instruction On error resume next
 
    If xlwbk Is Nothing Then ' si pas d'instance du classeur de créée
        Set xlwbk = xlapp.Workbooks.Open(cheminFichierDestination) ' on crée une nouvelle instance
    End If
 
    Set xlwsh = xlwbk.Sheets(nomFeuille) ' on référence la 1re feuille du classeur
 
    ' Commandes pour optimiser la procédure d'export
    xlapp.Calculation = xlCalculationManual ' désactive les calculs automatiques sur le classeur
    xlapp.ScreenUpdating = False ' désactive le rafraîchissement automatique de l'écran
    xlapp.EnableEvents = False ' désactive les événements
 
    idColonneMax = rst.Fields.Count
    idligneMax = xlwsh.Cells(xlwsh.Columns(1).Cells.Count, 1).End(xlUp).Row ' on considère la dernière ligne comme indice maxi
 
    If Not ajout Then ' si pas mode ajout on considère la 1re ligne comme indice maxi
        xlwsh.Range(xlwsh.Cells(1, 1), xlwsh.Cells(idligneMax, idColonneMax)).ClearContents ' efface les anciennes données
        idligneMax = 1 ' on considère la 1re ligne comme indice maxi
    End If
 
    idLigne = idligneMax + 1 ' indice de la 1re ligne vierge sur la feuille du classeur disponible pour l'ajout
 
    ' mise à jour des en-têtes dans la feuille sur la 1re ligne
    For idColonne = 1 To rst.Fields.Count
        xlwsh.Cells(1, idColonne).Value = rst.Fields(idColonne - 1).Name ' copie du nom du champ
    Next idColonne
 
    xlwsh.Range("A" & idLigne).CopyFromRecordset rst ' copie du contenu du recordset à partir de l'indice de la ligne
 
    MsgBox "Export réalisé avec succès !", vbExclamation
 
err_ExportData:
 
    If Err.Number <> 0 Then
        MsgBox (Err.Description)
    End If
 
    On Error Resume Next
 
    xlapp.ScreenUpdating = True ' active le rafraîchissement automatique de l'écran
    xlapp.EnableEvents = True ' active les événements
    xlapp.Calculation = xlCalculationAutomatic ' active les calculs automatiques des formules
 
    If Not (rst Is Nothing) Then
        rst.Close
    End If
 
    ' libère et ferme les variables objet
    Set rst = Nothing
    Set dbs = Nothing
 
    Set xlwsh = Nothing
 
    xlwbk.Close True ' on ferme avec sauvegarde du classeur
    Set xlwbk = Nothing
 
    xlapp.Quit ' quitte Excel
    Set xlapp = Nothing
 
End Sub
 
Function IsFile(ByVal fileName As String) As Boolean
     IsFile = (Dir(fileName) > "")
End Function
 
Public Function ExtractFileName(ByVal FilePath As String) As String
        ExtractFileName = Mid(FilePath, InStrRev(FilePath, "\") + 1)
End Function

ExportData "select * from T_Article where Export=False order by DesignationArticle;", "c:\Documents\Articles.xlsx", "Feuil1", True