Macro listing fichiers dans répertoire et copie cellules
Bonjour,
Je suis tout nouveau dans le forum.
Pour me faciliter la tache, j'ai recherché une macro me permettant de lister les fichiers (avec hyperlien) se trouvant dans un répertoire.
J'ai trouvé la macro "magique" et elle fonctionne à merveille.
Là ou je peine, c'est de pouvoir copier une cellule particulière (nom d'un technicien) dans le listing final. Les fichiers listés sont tous identiques (le nom diffère). En fait c'est un résumé que chaque technicien doit faire lorsqu'un travail est terminé. Et dans la cellule B9, se trouve son prénom que j'aurai voulu récupérer dans le récapitulatif.
Mais un exemple parlant plus que mon blabla, je vous joint le fichier récapitulatif ainsi qu'un exemple de fiche excel que les techniciens doivent remplir.
En espérant avoir été clair et avoir de l'aide pour compléter cette macro.
Cordialement,
Rastanet
Bonjour,
avec le chemin complet du fichier on peut lire la cellule B9 sans ouvrir le fichier,
voici un exemple,
Sub LireCelluleB9()
Dim Arg As String, Chemin As String, Fichier As String, Feuille As String, cellule As String, résultat As String
Chemin = "C:\Users\Emmanuel\Documents\BrouillonBis\"
Fichier = "145_Tests Gre´goire_18.08.17.xlsx"
Feuille = "Sheet1"
cellule = Range("B9").Range("A1").Address(, , xlR1C1)
Arg = "'" & Chemin & "[" & Fichier & "]" & Feuille & "'!" & cellule
résultat = ExecuteExcel4Macro(Arg)
End Sub
Bonsoir,
Merci pour cet exemple de fonctionnalité. Comment intégrer tout celà pour que celà se fasse de manière automatique - comme le Fichier Excel récapitulatifs avec liens hypertext ?
Devrais-je faire appel à cette nouvelle fonction via une autre feuille / macro ?
Devrais-je créer une macro par feuille excel (chemin complet) ?
Merci de votre aide
Rastanet
Bonjour,
voici un autre exemple sur votre fichier, il faudra adapter à votre répertoire votre fichier "145_Tests Grégoire_18.08.17.xlsx"
la macro et la function sont dans le module1
Bonjour,
Merci pour cette intégration. Mon idée serait aussi de pouvoir récupérer la cellule B9 de tous les fichiers répertoriés et ce de manière automatique. Pour rappel, mon répertoire (contenant les fiches excel des techniciens) possèdent plus de 200 fichiers. Chaque fichier s'intitule : "xxx_NomDeIntervention.xls"
XXX = nombre incrémenté au fur et à mesure.
Mon fichier "Exploreur_Rep_SousRep.xls" scanne le répertoire choisi et liste toutes les fiches avec lien hypertext. Pourrais-t-on en fait intégrer la fonction "LireCellule" dans le processus de listing
Désolé si je n'ai pas été clair au départ.
Merci pour le temps accordé
Bonjour rastanet,
voici ma solution de débutant, ton code integré pour récupérer de manière automatique dans la colonne F la cellule B9 de tous les fichiers répertoriés:
Function ListeFichier(Chemin As String) As String
Dim Dossier As Object, SousDossier As Object, Fichier As Object
Dim MyPath As String
Dim MyName As String
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
With Sheets("ACCUEIL")
For Each SousDossier In Dossier.SubFolders
.Cells(I, 2) = SousDossier.Name
For Each Fichier In SousDossier.Files
.Cells(I, 3) = Left(Fichier.Name, InStr(Fichier.Name, ".") - 1) 'Nom du fichier avec l'extension
ActiveSheet.Hyperlinks.Add Anchor:=Cells(I, 3), Address:=SousDossier & "\" & Fichier.Name
.Cells(I, 4) = Fichier.DateCreated ' Date de création
.Cells(I, 5) = Fichier.DateLastModified ' dernière modification
I = I + 1
Next
Next
End With
Range("F16").Select
MyPath = Range("B12") & "\" & Range("B16") & "\"
MyName = Dir(MyPath, vbNormal)
Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then
If (GetAttr(MyPath & MyName) And vbNormal) = vbNormal Then
ActiveCell.FormulaR1C1 = "='" & MyPath & "[" & MyName & "]Sheet1'!R9C2"
ActiveCell.Offset(0, 0).Value = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
End If
End If
MyName = Dir
Loop
End Function
Bonjour à tous,
Rastanet,, peut-tu joindre un fichier avec quelque résultat, j'aimerais voir la disposition des données récoltées avec votre macro pour mieux adapter la macro pour lire la cellule B9.
Un grand merci à Sequoyah. Le code est bon. Juste quelques soucis. Si le listing scanne 2 répertoires en même temps (projet en cours et projets terminés), les noms des techniciens sont affichés uniquement pour le 1er répertoire. La recherche des noms s'arrête à la fin du 1er répertoire
@sabV, voici le fichier avec quelques données récoltées. Bien entendu les données sont fausses et les liens hypertext sont égalements faux.
Merci pour votre aide.
Rastanet
Bonjour,
dans la cellule B9, se trouve son prénom que j'aurai voulu récupérer
ce code devrai faire ce que vous voulez, quel est le problème ?
ActiveCell.FormulaR1C1 = "='" & MyPath & "[" & MyName & "]Sheet1'!R9C2"
Bonjour Rastanet,
Une possible solution (ça marche seulement avec un dossier + deux sous-dossiers):
Function ListeFichier(Chemin As String) As String
Dim Dossier As Object, SousDossier As Object, Fichier As Object
Dim MyPath As String
Dim MyPath2 As String
Dim MyName As String
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
With Sheets("ACCUEIL")
For Each SousDossier In Dossier.SubFolders
.Cells(I, 2) = SousDossier.Name
For Each Fichier In SousDossier.Files
.Cells(I, 3) = Left(Fichier.Name, InStr(Fichier.Name, ".") - 1) 'Nom du fichier avec l'extension
ActiveSheet.Hyperlinks.Add Anchor:=Cells(I, 3), Address:=SousDossier & "\" & Fichier.Name
.Cells(I, 4) = Fichier.DateCreated ' Date de création
.Cells(I, 5) = Fichier.DateLastModified ' dernière modification
I = I + 1
Next
Next
End With
Range("F16").Select
MyPath = Range("B12") & "\" & Range("B16") & "\"
MyName = Dir(MyPath, vbNormal)
Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then
If (GetAttr(MyPath & MyName) And vbNormal) = vbNormal Then
ActiveCell.FormulaR1C1 = "='" & MyPath & "[" & MyName & "]Sheet1'!R9C2"
ActiveCell.Offset(0, 0).Value = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
End If
End If
MyName = Dir
Loop
MyPath2 = Range("B12") & "\" & ActiveCell.Offset(0, -4) & "\"
MyName = Dir(MyPath2, vbNormal)
Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then
If (GetAttr(MyPath2 & MyName) And vbNormal) = vbNormal Then
ActiveCell.FormulaR1C1 = "='" & MyPath2 & "[" & MyName & "]Sheet1'!R9C2"
ActiveCell.Offset(0, 0).Value = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
End If
End If
MyName = Dir
Loop
End Function
Bonjour,
Merci de votre réponse. En fait le souci vient du fait que je scanne (à la recherche de fichiers) 2 sous-dossiers et plus.
Si je me limite à 1 seul sous-dossier, je n'ai aucun souci. Mais si je scanne en même temps 2 ou plus, je n'ai pas l'affichage des noms des techniciens.
Ci-joint le fichier avec quelques exemples.
J'ai 2 sous-dossiers : "En Cours" & "Terminés"
"En cours" : scanne OK, nom des techniciens OK
"Terminés" : scanne OK, nom des technciens KO - absents
pour l'exemple, j'ai pris les mêmes fichiers et je les ai dupliqués dans les 2 sous-dossiers, sans aucunes modifications
Merci
Rastanet
Bonjour,
le dernier code que j'ai posté est différent du precedent et dans mon test avec un dossier et deux sous-dossiers le nom des techniciens est affiché de façon correcte. Si on a plus de deux sous-dossier on doit chercher une solution différente.
Bonsoir,
En effet, je n'avais pas vu le post précédent. Il fcontionne à merveille. Encore un très très grand merci.
On va pouvoir mettre ce post comme résolu.
Cordialement