Macro pour import de données avec fichier source variable
Bonjour à tous
Je me tourne vers la communauté car je rencontre un problème pour importer des données depuis un fichier source dont le nom est variable. En pièce jointe au format zip se trouvent deux documents :
- "Programmation" qui est le fichier où les données doivent être importées,
- "Données métrés pièces BSG" qui est le fichier source.
L'idée est la suivante : en fonction des valeurs présentes en D7:D27 de la feuille "Programmation", la macro devrait rechercher dans le fichier source le nom et renvoyer les valeurs présentes dans les colonnes :
- B du fichier source vers la colonne E de la feuille "Programmation"
- C du fichier source vers la colonne F de la feuille "Programmation"
L'adresse du fichier source est donnée dans la feuille "Sources" en H11 et est créée grâce aux données utilisateurs situées sur la même ligne.
ATTENTION il ne s'agit pas toujours d'une correspondance exacte, on peut avoir "19 - Escalier" dans le fichier "Programmation" et "3 - Hall + 19 - Escalier + 8 - Mezzanine" dans le fichier source.
Dans un premier temps, je pensais me dispenser de macros grâce aux formules écrites en E29/F29 et E30/F30 de "Programmation" mais la formule n'est pas dynamique et/ou ne fonctionne que lorsque le classeur source est ouvert...
J'ai également essayé d'importer des fonctions complémentaires via le plugin "Morefunc", en particulier "INDIRECT_EXT" mais cela ne fonctionne pas super bien sous Excel 2010 : quand je quitte Excel et réouvre le document, le logiciel ne reconnaît plus la fonction "INDIRECT_EXT"... Je suis donc décidé à utiliser les macros pour éviter les mauvaises surprises.
P:S: Accessoirement je ne sais pas s'il est possible de créer une macro qui déterminerait automatiquement la plage décrite en F11 de "Sources". Le début du texte ne change pas, il s'agit toujours de A$4$ mais je me demande s'il n'est pas envisageable de déterminer la fin de la plage suivant le critère "Dernière ligne et colonne non vide" --> dans le cas présent C239.
Merci d'avance pour votre aide
Butterfly
Bonjour,
Merci beaucoup pour votre réactivité.
Je rencontre néanmoins un souci au moment de l'exécution de la macro. Voici le code erreur affiché :
"Erreur d'exécution '-2147217865 (800040e37)':
Le moteur de base de données Microsoft Access ,'a pas pu trouver l'objet Données métrés pièces BSG$. Vérifiez qu'il existe que vous avez correctement entré son nom et son chemin d'accès. Si données métrés pièces BSG$ n'est pas un objet local, vérifiez la connexion réseau, ou contactez l'administrateur du serveur."
Mes interrogations en gras ci-dessous
'nécessite d'activer la référence: Microsoft ActiveX Data Objects xx Library
Sub MAJ_SurfacesVolumes()
Dim Fich As String, rep As String, FeuilSource As String, Feuil_cellule_destination As String, i As Integer
With Sheets("Sources")
ligne = 11
rep = .Cells(ligne, "C").Value
Fich = .Cells(ligne, "D").Value & .Cells(ligne, "E").Value
FeuilSource = .Cells(ligne, "F").Value
cellule_source = .Cells(ligne, "G").Value
Feuil_cellule_destination = "Programmation" 'Valeur que j'ai modifiée mais je ne suis pas certain que ce soit la bonne chose à mettre
End With
LireCellule rep, Fich, FeuilSource, cellule_source, Feuil_cellule_destination 'je ne vois pas trop ce que je dois modifier ici, dois je remplacer Feuil_cellule_destination par "Programmation" ou y'a t'il autre chose ?
For i = 7 To 50 'serait'il possible ici de ne pas limiter la valeur à 50 mais plutôt jusqu'à la ligne -2 précédent celle où serait par exemple écrit "FIN" en E52 et F52 ?
c = """*"" &D" & i & " & ""*"""
t = "MATCH(" & c & ",Feuil1!A:A,0)"
n = Evaluate(t)
If Not IsError(n) Then
Sheets("Programmation").Cells(i, "E") = Application.Index(Sheets("Feuil1").Range("B:B"), n)
Sheets("Programmation").Cells(i, "F") = Application.Index(Sheets("Feuil1").Range("C:C"), n)
End If
Next
Sheets("Feuil1").Cells.ClearContents 'feuille cachée pour les données temporaires
End Sub
Function LireCellule(repertoire As String, fichier As String, Feuille As String, cellule_source, dest As String)
Set cnn = New ADODB.Connection
'--- Connexion ---
With cnn
.Provider = "Microsoft.Jet.OLEDB.12.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& repertoire & "\" & fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"""
.Open
End With
'--- récupérer les données --
Set rs = cnn.Execute("SELECT * FROM [" & Feuille & "$" & cellule_source & "]") 'Cellule surlignée lorsqu'on lance le débogage
Range(dest).CopyFromRecordset rs
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Function
Encore merci pour votre aide car je patine bien
Butterfly
Bonjour,
avez-vous activer la référence: Microsoft ActiveX Data Objects xx Library avant de faire le test ?
ps/ il n'y a pas de modification à faire à la macro.
Bonjour,
La référence Microsoft Active X Data Objects 6.1 Library est effectivement activé. La macro beugue à ce moment-ci :
Set rs = cnn.Execute("SELECT * FROM [" & Feuille & "$" & cellule_source & "]")
J'ai remis trait pour trait la macro que vous proposez et voici le message retourné cette fois-ci :
"Erreur d'exécution '-2147217865 (80040e37)':
Le moteur de base de données Microsoft Access n'a pas pu trouver l'objet Données métrés pièces BSG$. Vérifiez qu'il existe et que vous avez correctement entré son nom et son chemin d'accès. Si Données métrés pièces BSG$ n'est pas un objet local, vérifiez la connexion, ou contactez l'administrateur du serveur."
Est ce que le problème ne viendrait pas du $ écrit dans le message d'erreur ci-dessus ?
Par ailleurs, le code certes beugue mais cela supprime également le fichier source qui est dans le même répertoire :-/
Ci joint-les 2 fichiers en question.
Merci beaucoup pour le temps que vous m'accordez
Butterfly
revoici le fichier corrigé,
avant de faire le test,
sur la macro
modifier
ligne = 12
par
ligne = 11
Bonjour,
Je n'ai malheureusement pas réussi à faire fonctionner la macro, je suis donc passé par une autre solution :/...
Merci quand même pour votre aide !
Butterfly
Bonjour,
je suis donc passé par une autre solution
merci de partager votre solution avec tous les autre membres, le groupe est là pour ça.... merci!
Bonjour,
Désolé pour le retard, j'étais en congés
Voici le fichier en question en pièce jointe !
Butterfly