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

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

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____)