Effectuer des importations d'une base de donnée access vers excel en vba

Soyez le premier à donner votre avis sur cette source.

Vue 12 811 fois - Téléchargée 1 600 fois

Télécharger le projet
Commenter

Description

Bonjour à tous,

Je vous livre ici ma première source ! Ben oui, je n?ai pas eu le courage de commenter et de livrer tous les codes que j?ai pondus mais sur ce coup là, j'ai pensé à vous car j'ai galéré sur le sujet et je n'ai trouvé aucune source correspondant à mes besoins sur ce site. Vous me direz, j'avais peut être mal cherché (^_^) ! Si c'est le cas, toutes mes excuses !

Revenons en à ma source :
C'est un module qui sert à importer des données d'Access dans un fichier Excel en utilisant l'objet DAO. J'ai utilisé cette méthode car je n'arrivais pas à importer les données d'une base en Access 97 vers un Excel 97 !

Le module est je pense, très bien commenté alors je ne vous ferais pas l'affront de tout ré-expliquer.
Je fournis un Zip contenant un fichier Excel 97 et une base de donnée en Access 97 pour la démonstration mais aussi le fichier du module. De plus, je vous donne le code du module en vrac ci-dessous, comme ça, il y en as pour tous les goûts !

Je suis ouvert à toute critique donc, n'hésitez pas.

J'espère que ce bout de code vous serviras !

@peluche !

Source / Exemple : 


Dim Db As DAO.Database 'Objet base de donnée
Dim Rs As Recordset 'Objet qui contient les résultats de la requête
Dim Debut As Date 'Sert à définir le temps d'exécution
Dim Fin As Date 'Sert à définir le temps d'exécution
Dim EnregistrementsParSecondes As Integer 'Nombre d'enregistrements traités par seconde
Dim NbrChamp As Integer 'Nombre de champ par enregistrement
Dim NbrEnr As Integer 'Nombre d'enregistrements traités
Dim Source As String 'C'est la requête
Dim ConditionsDeLaRequeteFinale As String 'Variable qui contiendras les conditions reformatées
Dim Flag As Boolean 'c'est juste un flag, un repère quoi !
Dim L As Integer 'Ligne actuelle
Dim C As Integer 'Colonne actuelle

Public Function ImporterResultatRequeteAccessDansExcel(FichierBaseDeDonneeMDB, NomTable, ConditionsDeLaRequete, NomFichierExcel, NomOngletExcel, Rapport As Boolean)

    'Pour que cette macro fonctionne, il faut référencer au minimum
    '"Microsoft DAO 2.5/3.5 Compatibility Library".
    'Mais la macro fonctionne aussi avec des librairies plus récentes comme
    '"Microsoft DAO 3.0 Object Library" et "Microsoft DAO 3.5 Object Library".
    
    'Cette macro fonctionne sur toutes les versions d'Excel (testé sur Excel 97)
    'et toutes les versions d'Access (testé sur Access 97) vu qu'elles sont rétrocompatibles !
    
    'Cette fonction permet d'importer le résultat d'une requete
    'effectuée dans une base de donnée Access à l'interieur d'un onglet Excel
    
    'Exemple de la commande à lancer pour appeler cette fonction :
    'Call ImporterResultatRequeteAccessDansExcel(ThisWorkbook.Path & "\BDD.mdb", "table_test", "WHERE commentaire=CarteOrange", ThisWorkbook.Name, 1, True)
    
    'Exemple de la commande à lancer pour importer toute une table :
    'Call ImporterResultatRequeteAccessDansExcel(ThisWorkbook.Path & "\BDD.mdb", "table_test", "", ThisWorkbook.Name, 1, True)
    
    '________________________________________________________________________________
    'Enregistrer le momment exact de l'exécution de la fonction
    'Cela sert à calculer le temps d'exécution de la fonction à la fin de celle-ci.
    Debut = Now
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Récupérer le nom exact de l'onglet dans lequel l'import sera fait
    NomOngletExcel = Workbooks(NomFichierExcel).Sheets(NomOngletExcel).Name
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Activer l'onglet pour l'import
    Workbooks(NomFichierExcel).Sheets(NomOngletExcel).Select
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Ouverture de la base de donnée Access.
    Set Db = DBEngine.OpenDatabase(FichierBaseDeDonneeMDB, False, False, "MS Access")
    '________________________________________________________________________________
    
    
    
    '________________________________________________________________________________
    'Ajout de guillemets derrière les "=" de la requete
    ConditionsDeLaRequeteFinale = ""
    Flag = False
    If Not ConditionsDeLaRequete = "" Then
        For i = 1 To Len(ConditionsDeLaRequete)
            If Mid$(ConditionsDeLaRequete, i, 1) = "=" Then
                    
                    Flag = True
                    ConditionsDeLaRequeteFinale = ConditionsDeLaRequeteFinale & Mid$(ConditionsDeLaRequete, i, 1) & Chr(34)
                    
                ElseIf Flag = True And Mid$(ConditionsDeLaRequete, i, 1) = " " Then
                    ConditionsDeLaRequeteFinale = ConditionsDeLaRequeteFinale & Chr(34) & Mid$(ConditionsDeLaRequete, i, 1)
                    Flag = False
                    
                ElseIf Flag = True And Not i = Len(ConditionsDeLaRequete) Then
                    ConditionsDeLaRequeteFinale = ConditionsDeLaRequeteFinale & Mid$(ConditionsDeLaRequete, i, 1)
                    
                ElseIf Flag = True And i = Len(ConditionsDeLaRequete) Then
                    ConditionsDeLaRequeteFinale = ConditionsDeLaRequeteFinale & Mid$(ConditionsDeLaRequete, i, 1) & Chr(34)
                    Flag = False
                    
                ElseIf Flag = False Then
                    ConditionsDeLaRequeteFinale = ConditionsDeLaRequeteFinale & Mid$(ConditionsDeLaRequete, i, 1)
                    
            End If
        Next
    End If
    '________________________________________________________________________________
    
    
    '________________________________________________________________________________
    'Définition de la requête qui seras effectuée dans la Base de données
    If Not ConditionsDeLaRequete = "" Then
            Source = "SELECT * FROM " & NomTable & " " & ConditionsDeLaRequeteFinale
        Else
            Source = "SELECT * FROM " & NomTable
    End If
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Effectuer la requête
    Set Rs = Db.OpenRecordset(Source)
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Définir le nombre d'enregistrements et de champs qui résultent de la requête.
    '
    'Les enregistrements sont les lignes de la base de données et les
    'champs sont en fait les colonnes.
    Rs.MoveLast
    NbrEnr = Rs.RecordCount
    Rs.MoveFirst
    NbrChamp = Rs.Fields.Count
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Ecrire les nom des champs en entête dans l'onglet du fichier Excel
    L = 1
    For C = 0 To NbrChamp - 1
        Workbooks(NomFichierExcel).Sheets(NomOngletExcel).Cells(L, C + 1) = Rs.Fields(C).Name
    Next
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Ecrire les résultats de la requête dans l'onglet du fichier Excel
    For L = 1 To NbrEnr
        For C = 0 To NbrChamp - 1
            Workbooks(NomFichierExcel).Sheets(NomOngletExcel).Cells(L + 1, C + 1) = Rs.Fields(C).Value
        Next
    Rs.MoveNext
    Next
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Cela sert à calculer le temps d'exécution de la fonction à la fin de celle-ci.
    Fin = Now
    '________________________________________________________________________________
    
    
    '________________________________________________________________________________
    'Mettre l'entête en gras, activer le filtrage automatique et redimensionner
    'les colonnes automatiquement.
    Rows("1:1").Select
    Selection.Font.Bold = True
    Selection.AutoFilter
    Cells.Select
    Selection.Columns.AutoFit
    Cells(2, 1).Select
    Cells(1, 1).Select
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Fermer la base de donnée
    Rs.Close
    Db.Close
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Libérer les objet utilisés pour la base de donnée
    Set Rs = Nothing
    Set Db = Nothing
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Afficher le rapport final si il est demandé
    If Rapport = True Then
        Tps = DateDiff("s", Debut, Fin)
        If Tps > 0 Then
                EnregistrementsParSecondes = NbrEnr / Tps
            Else
                EnregistrementsParSecondes = NbrEnr
        End If
        MsgBox "Base de donnée : " & FichierBaseDeDonneeMDB & Chr(10) & _
               "Requête : " & Source & Chr(10) & Chr(10) & _
               "Fichier Excel : " & NomFichierExcel & Chr(10) & _
               "Nom de l'onglet : " & NomOngletExcel & Chr(10) & Chr(10) & _
               "Temps d'exécution : " & Tps & " secondes" & Chr(10) & _
               "Nombre d'enregistrements : " & NbrEnr & Chr(10) & _
               "Nombre d'enregistrements traités par secondes : " & EnregistrementsParSecondes & Chr(10) _
               , vbInformation, "Rapport de la requête"
    End If
    '________________________________________________________________________________
    
End Function

Conclusion :


N'hésitez pas à commenter ma source !
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
cs_hdidan
Messages postés
2
Date d'inscription
dimanche 30 janvier 2005
Statut
Membre
Dernière intervention
26 juin 2005
Je trouve ton code source intéressant. Moi aussi, j'ai un problème disons similaire au tien. Je cherche à importer des données Access sur Excel (ton code me donne des idées) ainsi que des données Excel sur Access. Pour cette 2ème partie, si tu peux m'être d'une aide quelle conque.
J'ai trouvé sur le site des codes mais que j'arrive pas à faire tourner : il reconnait pas Dim "MonAccess As New Access.Application" même si j'ai ajouté le microsoft DAO.
Signaler
Cramfr
Messages postés
160
Date d'inscription
mercredi 24 novembre 2004
Statut
Membre
Dernière intervention
8 juillet 2008
Vous avez pensez à ADO ???
Signaler
jmlucienvb
Messages postés
129
Date d'inscription
mercredi 24 septembre 2003
Statut
Membre
Dernière intervention
12 février 2009
DAO ne suffit pas pour que access soit reconnu
Il faut aussi que la bibliothèque d'office soit déclarée...
Au bureau j'ai des codes simples quoi fonctionnenet en permanence pour les échanges excel access dans les deux sens en version 97...
Un petit mail je vous les envoie...
(jean-marc.lucien@acoss.fr)
Avant jeudi après je pars en congés.
Sinon ado n'est pas top avec office 97 mais après avec 2000 ou xp c'est bien plus simple
JM
Signaler
pbrenas
Messages postés
1
Date d'inscription
lundi 13 juin 2005
Statut
Membre
Dernière intervention
28 juin 2005
aprés avoir testé plusieurs méthodes, pour récupérer la totalité des enregistrement sélectionnés si le résultat à moins de 65534 enregistrements,
la fonction query d'excel est plus rapide:
connec = "ODBC;DSN=piloteodbc;UID=;PWD=1234;DBQ=\\SERVEUR\Mesdocs\sage;DefaultDir=;CODEPAGE=1252;" pour la liaison avec sage ligne 100
piloteodbc est crée dans la liste des bases personnelles dans outils d'administration , pilotes odbc
sel contient la requête SQL
A1 est la position de la première cellule de destination
With ActiveSheet.QueryTables.Add(Connection:=Connec, Destination:=Range("A1"))
.CommandText = Sel
.Name = ta
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.PreserveColumnInfo = False
.Refresh BackgroundQuery:=False
End With
j'ai trouvé cette fonction en enregistrant une macro sur données, données externe, créer une requette.

Cela ne fonctionne pas pour écrire sur les base, les fonction ADO sont nécéssaire.
merci pour ce source trés bien commenté.
Signaler
andrieuremi
Messages postés
14
Date d'inscription
mercredi 18 juin 2003
Statut
Membre
Dernière intervention
21 juin 2007
Je trouve ton code source parfait.
Cela fait des mois que je cherche une telle source.
Je voulais te demander si tu pouvais compléter cette source en gérant lors de l'ouverture de la base de données le mot de passe du fichier car ma base auquel se souhaiterais me connecter possède un mot de passe et le code source ne le gère pas. MERCI INFINIMENT!
Afficher les 15 commentaires
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 (Squall____)