Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
je dois importer des donnés contenu dans un classeur excel, en indiquant le dossier où est stocké le fichier voulu.
voila le type d'architecture du répertoire de stockage :
Do While sPath = ""
Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
With Fd
If .Show = -1 Then
sPath = .SelectedItems.Item(1) & "\"
End If
End With
Loop
ou alors :
VB:
Sub RechercheDossier()
Dim oSh As Object, pFile As Object, pIni$
Set oSh = CreateObject("Shell.Application")
On Error Resume Next
Set pFile = oSh.BrowseForFolder(0&, "Sélectionnez un dossier", &H40 + &H200 + &H4000, "C:\Users\.....\Desktop\")
'&H200 permet d'afficher ou non Création de dossier
'&H4000 permet d'afficher ou non les fichiers dans les répertoires
On Error GoTo 0
If Not pFile Is Nothing Then
MsgBox pFile.Items.Item.Path & "\"
End If
End Sub
Cela permet de rechercher le dossier et sous-dossier
Je viens de tester la solution 2 mais apparemment je ne me suis pas fais bien comprendre.
elle m'ouvre une fenêtre où c'est l'utilisateur qui doit chercher lui même. Ce que je cherche , c'est que ça soit Excel qui cherche lui même le dossier.
Je viens de teste la solution 2 mais apparemment je ne me suis pas fais bien comprendre.
elle m'ouvre une fenêtre où c'est l'utilisateur qui doit chercher lui même. Ce que je soit c'est que ça soit Excel qui cherche lui même le dossier.
il à en mémoire le chemin d’accès du dossier racine ( nommé ici "répertoire" ) , et en fonction du numéro de dossier et de sous-dossier, il effectue la recherche du ficher Excel désiré.
je vais tester la solution 1.
édit: j'ai oublier de préciser : je suis en mode "Option Explicite" et ce fichier est destiné à être utilisé avec Excel 2003 et 2010
édit 2: je n'arrive pas a faire fonctionner la solution 1
merci Yaloo de prendre un peu de ton temps pour m'aider 😉
mon chef avait réussi à faire une marco qui , en fonction du numéro de dossier , recherchait dans chaque sous-dossiers un fichier Excel en particulier parmi tous les fichiers. un fois qu'il a trouvé les Classeurs, sans les ouvrir la macro recopie des cellules en particulier.
Je ne peux malheureusement pas tout mettre sur le net, il y a des infos confidentielles de mon boulot dedans mais je peux mettre le début, la phase de recherche de dossier.
voila c'est un peu long
Code:
' importation start
Private Sub ds_import_bouton_Click()
Dim YearNo As String
Dim ProjectNo As String
Dim RevisionNo As String
Dim Row As Long
ChDrive "T"
ChDir ".... chemin d’accès de mon dossier racine..." ' le répertoire dans l'exemple
Row = ActiveCell.Row
YearNo = ActiveSheet.Name
ProjectNo = Format(Cells(Row, 3), "0000") ' dossier "projet" de l'exemple
OpenTheProject YearNo, ProjectNo 'step 1
OpenTheProjectRevision RevisionNo 'step 2 recherche du dossier
GetInfosFromAllItemAndAlternatives 'step 3
end sub
step 1
Code:
Sub OpenTheProject(YearNo As String, ProjectNo As String) '
Dim test As String
Dim Projectfoldername As String
Projectfoldername = Dir$(YearNo & "\", vbDirectory)
Do Until Left(Projectfoldername, 4) = Left(ProjectNo, 4)
Projectfoldername = Dir$()
If Projectfoldername = "" Then
MsgBox ("Offer " & ProjectNo & " not found.")
End
End If
Loop
test = YearNo + "\" + Projectfoldername + "\"
ChDir test
End Sub
step 2
Code:
'step 2
Sub OpenTheProjectRevision(RevisionNo As String)
Dim FolderName As String
Dim RevisionFolderName As String
Dim truc As String
MsgBox CurDir
FolderName = Format(revision_box.Value, "00")
RevisionFolderName = Dir(FolderName + "\")
ChDir RevisionFolderName
MsgBox CurDir
If CurDir <> Dir(FolderName + "\") Then
MsgBox ("Revision " & FolderName & " not found")
End
End If
End Sub
le step1 et la suite fonctionne correctement donc pas besoin de la mettre.
c'est juste au niveau du step 2 que ça coince...
j'ai remis un dossier type comme ceux de mon boulot.
edit :
mon chef est venu et m'a apporté un debut de solution : dans le step 2 la ligne:
RevisionFolderName = Dir(FolderName + "\") est fausse, il faut supprimer le Dir
Code:
Sub OpenTheProjectRevision(RevisionNo As String)
Dim FolderName As String
Dim RevisionFolderName As String
Dim truc As String
FolderName = Format(revision_box.Value, "00")
RevisionFolderName = FolderName + "\"
ChDir RevisionFolderName
End Sub
maintenant il me manque l'instruction pour stoper l'excecution du programme sans fermer l'userform si le dossier de révision n'existe pas.
j'ai mis à jour les précédant post, et je vais ré-expliquer mon problème avec le code d'origine, comme ça plus de confusion possible.
donc j'ai une marco qui va copier des cellule dans un classeur Excel. Ce dernier doit resté fermer pendant la copie. Ce fichier Excel est ranger comme dans le nouveau dossier joint.
la macro compare les 4 premiers caractères des nom de dossiers dans le répertoire avec le numéro de projet.
une fois que le dossier est trouvé, la macro cherche le dossier qui à le même nom que la valeur dans la revision_box.
enfin elle cherche tous les fichiers qui s'appelle "classeur1.xls", copier une cellule en particulier sans ouvrir le document, et la colle dans mon classeur actuel .
voila en gros le principe.
donc mon chef et moi avons réussie à coder la macro, elle marche presque totalement, le seul hic, c'est au moment de choisir la révision, la macro plante, elle ne trouve pas le chemin.
ce qui est bizarre, c'est que ça marche pour un projet en particulier, et les autres impossible de trouver les révision.
dans les fichiers joints, j'ai virée les infos confidentielles et j'ai adapter le code à l'exemple
donc mes questions :
1- comment coder pour que la macro chercher les dossier correspondant au révision ?
2-en cas de chemin introuvable, comment arrêter le module en cours (exit sub quitte le sub en cours, mais le programme continue lui, et forcément il plante ) sans pour autant quitter l'userform ( end quitte tout, le sub , le module et l'userform)
Je ne suis pas très calé pour ce genre de question.
Mais j'ai essayé de suivre ton raisonnement. Plusieurs questions :
- Si tu as plusieurs fichiers Classeur1.xlsx, dans plusieurs sous-répertoire cela t'indiquera la valeur du dernier fichier trouvé (donc dernier sous-répertoire)
moi aussi je te rassure, j'ai tout appris sur le tas.
- Si tu as plusieurs fichiers Classeur1.xlsx, dans plusieurs sous-répertoire cela t'indiquera la valeur du dernier fichier trouvé (donc dernier sous-répertoire)
en faite non , il explore le premier fichier, importe les donnée , passe au ficheir suivant et ainsi de suite. c'est vers la fin de module " step 322", il fait un genre de boucle ( me demande pas comment, c'est mon chef qui ma sorti ça )
- Si tu as plusieurs fichiers Classeur1.xlsx, dans plusieurs sous-répertoire cela t'indiquera la valeur du dernier fichier trouvé (donc dernier sous-répertoire)
en faite non , il explore le premier fichier, importe les donnée , passe au ficheir suivant et ainsi de suite. c'est vers la fin de module " step 322", il fait un genre de boucle ( me demande pas comment, c'est mon chef qui ma sorti ça )
ah zut, en faisant le trie, j'ai viré la boucle qui insérait une ligne quand il change de fichier, voila le code a remplacer:
Code:
' step 32
Sub GetInfosFromItemAlternative(ItemAlternativeName As String, iRow As Long)
'Dim IAName As String
Dim DataFileName As String
Dim donnee As String
Dim line As String
DataFileName = "Classeur1.xls "
'322
donnee = GetInfoFromClosedFile(ItemAlternativeName, "Classeur1.xls", "Feuil1", "c4")
If iRow = 1 Then
line = 8
Cells(line, 7).Activate
Else
line = ActiveCell.Row + 1
Cells(line, 7).Activate
Selection.EntireRow.Insert
End If
ActiveSheet.Cells(8, line).Value = donnee
End Sub
sinon tu arrives à le faire marcher correctement? il t'indique "revision not found"?
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD