Soyez le premier à donner votre avis sur cette source.
Vue 12 981 fois - Téléchargée 1 614 fois
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
Mais si tu trouves une autre solution hesites pas a faire signe, ton code avait l'air interessant ;)
Pour régler votre problème, il vaut mieux essayer de le réinstaller en le téléchargeant ici :
http://www.download.com/Microsoft-Jet-Database-Engine-3-5/3000-2114_4-4238277.html
Sinon, j'ai trouvé un article pour vérifier l'installation du pilote JET 3.5 chez Microsoft ici :
http://support.microsoft.com/kb/240377
Je pense que ça devrais suffire à résoudre votre problème.
J'ai essaye avec la version 3.5 et 3.6 ainsi qu'avec Microsoft DAO 2.5/3.5 Compatibility Library.
Toujours le meme message d'erreur...
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.