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