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 !
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.