Ce billet s'adresse principalement aux utilisateurs d'Access qui ne connaissent pas très bien le modèle objet d'Excel et toutes les astuces nécessaires pour bien piloter le tableur.
On s'est tous retrouvés un jour à vouloir faire un export dans un fichier Excel avec des problèmes de lenteur, de fichier déjà ouvert ou de processus déjà chargé en mémoire, avec comme conséquence une procédure qui ne finit pas, ou carrément un plantage de l'application.
On va donc voir comment on peut contourner ces problèmes avec un exemple simple d'exportation d'une source de données Access dans un classeur.
Introduction :
On dispose d'une table ou d'une requête côté Access que l'on souhaite exporter dans un fichier Excel.
Pour une meilleure compréhension des choses, j'utilise du Early Binding qui nécessite de déclarer les variables objet dans un type précis, et de cocher la référence Microsoft Excel XX.X Object Library.
Les bonnes pratiques
1/ - Déclarer les variables objet en début de code
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
2/ - Utiliser une gestion d'erreur
Elle va permettre en particulier de libérer la mémoire en cas d'erreur :
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
3/ - Utiliser l'instance du fichier Excel si celui-ci est déjà ouvert
3.1/ - Création de l'objet application xlapp :
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
3.2/ - Création de l'objet xlwbk pour le classeur
Le fichier est déjà ouvert, comment éviter les problèmes de conflit en écriture ?
Pour cela, on va utiliser une instruction qui va permettre de récupérer l'instance du classeur déjà ouvert :
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
4/ - Pour optimiser le temps d'exécution du code
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
Réactiver ces options à la fin du code :
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
5/ - Libérer les variables objet en fin de procédure
Pour libérer la mémoire et éviter de se retrouver avec des processus "fantômes", il faut impérativement mettre ces variables à nothing
' 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
La procédure complète
Arguments
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
On exporte simplement en passant à la procédure les bons arguments :
ExportData "select * from T_Article where Export=False order by DesignationArticle;", "c:\Documents\Articles.xlsx", "Feuil1", TrueVous avez lu gratuitement 2 921 articles depuis plus d'un an.
Soutenez le club developpez.com en souscrivant un abonnement pour que nous puissions continuer à vous proposer des publications.
Soutenez le club developpez.com en souscrivant un abonnement pour que nous puissions continuer à vous proposer des publications.