Export automatisé données table ou requête access dans un classeur excel

Soyez le premier à donner votre avis sur cette source.

Snippet vu 13 406 fois - Téléchargée 18 fois

Commenter

Contenu du snippet

Ce code permet d'exporter les résultats d'une requête ou d'une table ACCESS dans un nouveau classeur Excel, le code peut être facilement adapté pour réaliser l'export dans un classeur existant.
Il est nécessaire de rajouter les références:
Microsoft 12.0 Object Library
Microsoft DAO 3.6 Object Library
Les fonctions suivantes permettent un export des données uniquement ou des données et des entêtes de colonnes

Source / Exemple : 


Function export_excel_avec_entetes(ByVal nomrequete As String)
''ajouter les references Microsoft 12.0 Object Library
''ajouter les references Microsoft DAO 3.6 Object Library
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim objExcel As Excel.Application
Dim objWorkBook As Excel.Workbook
Dim objFeuille As Excel.Worksheet
nomrequete = "paper"
Dim i, j As Integer
Set objWorkBook = Workbooks.Add
'supprimer les feuilles 2 et 3
objWorkBook.Sheets(3).Delete
objWorkBook.Sheets(2).Delete
Set objFeuille = objWorkBook.Sheets(1)
'nommer la feuille de l'export cible
objFeuille.Name = "Export"
Set db = CurrentDb
Set rs = db.OpenRecordset("select * from " & nomrequete, dbOpenDynaset)
i = 1
'renseigner les entêtes de colonnes
    For j = 0 To rs.Fields.Count - 1
        objFeuille.Cells(1, i) = rs.Fields(j).Name
        i = i + 1
    Next j
'renseigner les données
objFeuille.Cells(2, 1).CopyFromRecordset rs
objWorkBook.Application.Visible = True
objWorkBook.Activate
''libération de la mémoire
Set objWorkBook = Nothing
Set objFeuille = Nothing
Set db = Nothing
Set rs = Nothing
End Function
Function export_excel_sans_entetes(ByVal nomrequete As String)
''ajouter les references Microsoft 12.0 Object Library
''ajouter les references Microsoft DAO 3.6 Object Library
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim objExcel As Excel.Application
Dim objWorkBook As Excel.Workbook
Dim objFeuille As Excel.Worksheet
Set objWorkBook = Workbooks.Add
'supprimer les feuilles 2 et 3
objWorkBook.Sheets(3).Delete
objWorkBook.Sheets(2).Delete
Set objFeuille = objWorkBook.Sheets(1)
'nommer la feuille de l'export cible
objFeuille.Name = "Export"
Set db = CurrentDb
Set rs = db.OpenRecordset("select * from " & nomrequete, dbOpenDynaset)
'renseigner les données
objFeuille.Cells(1, 1).CopyFromRecordset rs
objWorkBook.Application.Visible = True
objWorkBook.Activate
''libération de la mémoire
Set objWorkBook = Nothing
Set objFeuille = Nothing
Set db = Nothing
Set rs = Nothing
End Function

A voir également

Ajouter un commentaire

Commentaires

Signaler
cs_comme
Messages postés
122
Date d'inscription
dimanche 19 mars 2006
Statut
Membre
Dernière intervention
18 juillet 2009
Bjrs
Comment appeller cette function ,de plus si on utilise ado et non le dao
Signaler
houtas
Messages postés
116
Date d'inscription
jeudi 14 décembre 2006
Statut
Membre
Dernière intervention
29 août 2013
Salut FG10 ta remarque est pertinente, mais j'ai préféré faire deux fonctions séparés, afin de ne garder qu'un seul argument le nom de la requête ou la table, ce qui facilite la réutilisation du code pour un débutant, l'ajout de la variable boolean permet d'avoir une seule fonction qui fait les deux, mais implique également le rajout d'une variable qui sera fonction de la valeur du boolean pour placer les données en ligne 1 ou ligne 2.
Signaler
gmerca
Messages postés
1
Date d'inscription
jeudi 17 septembre 2009
Statut
Membre
Dernière intervention
25 mai 2010
Merci beaucoup poour ce code, ça fait un moment que je cherchais comment importer des entêtes de colonnes par VBA pour une table MS SQL 2005. Ca marche très bien.
Signaler
fg10
Messages postés
34
Date d'inscription
samedi 26 avril 2003
Statut
Membre
Dernière intervention
24 mai 2010
 1
pour infole code peut etre reduit de 50% si

Function export_excel(ByVal nomrequete As String,entete as boolean)

if entete then
# 'renseigner les entêtes de colonnes
# For j = 0 To rs.Fields.Count - 1
# objFeuille.Cells(1, i) = rs.Fields(j).Name
# i = i + 1
# Next j
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (houtas)