XL 2013 Spécifier chemin d'accès

[Etn]

Bonjour !

J'espère que vous avez passé un bon week-end !

Je reviens vers vous car, débutant dans excel, je cherche à créer une macro afin de consolider plusieurs fichiers de différents dossiers, et après avoir cherché des informations à gauche à droite, je me retrouve avec les codes ci-dessous :

Private Function ChoisirDossier() As String
 Dim objShell
 Dim objFolder
 Set objShell = CreateObject("Shell.Application")
 Set objFolder = objShell.BrowseForFolder _
     (&H0&, "Sélectionnez un Dossier", &H1&)
 On Error GoTo Erreur
 ChoisirDossier = objFolder.ParentFolder _
     .ParseName(objFolder.Title).Path & ""
 Exit Function
Erreur:
 ChoisirDossier = ""
 End Function

 Sub PRENOM()

 Dim FSO 'As Scripting.FileSystemObject
 Dim SourceFolder 'As Scripting.Folder
 Dim FileItem 'As Scripting.File
 Dim chemin$
 Dim T()
 Dim cpt&
 Dim g&
 Dim i&
 Dim j&
 Dim Lig&
 Dim var
 Dim WB As Workbook
 Dim S As Worksheet
 Dim DEST As Worksheet
 Dim Info(1 To 1, 1 To 26)
 '------------
 chemin$ = ChoisirDossier
 If chemin$ = "" Then Exit Sub
 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set SourceFolder = FSO.GetFolder(chemin$)
 If SourceFolder.Files.Count = 0 Then Exit Sub
 For Each FileItem In SourceFolder.Files
   If LCase(Right(FileItem.Name, 4)) = ".xls" Then
     cpt& = cpt& + 1
     ReDim Preserve T(1 To cpt&)
     T(cpt&) = chemin$ & "\" & FileItem.Name
   End If
 Next FileItem
 Set FileItem = Nothing
 Set SourceFolder = Nothing
 Set FSO = Nothing
 '------------
 Application.ScreenUpdating = False
 Set DEST = Sheets.Add
 Lig& = 1
 For g& = 1 To UBound(T)
   Set WB = GetObject(T(g&))
   Set S = WB.Sheets("PRENOM")
   Info(1, 1) = S.Range("f4")
   WB.Close
   Set WB = Nothing
   Lig& = Lig& + 1
   DEST.Range(DEST.Cells(Lig&, 1), _
         DEST.Cells(Lig&, UBound(Info, 2))) = Info
   Erase Info
 Next g&
 var = Array("PRENOM")
 With DEST
   .Range(.Cells(1, 1), .Cells(1, UBound(var) + 1)) = var
   .Range("a1").Interior.ColorIndex = 6
 End With
 Application.ScreenUpdating = False
 Exit Sub
Erreur:
 Application.ScreenUpdating = False
 MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description
 End Sub

et

Private Function ChoisirDossier() As String
 Dim objShell
 Dim objFolder
 Set objShell = CreateObject("Shell.Application")
 Set objFolder = objShell.BrowseForFolder _
     (&H0&, "Sélectionnez un Dossier", &H1&)
 On Error GoTo Erreur
 ChoisirDossier = objFolder.ParentFolder _
     .ParseName(objFolder.Title).Path & ""
 Exit Function
Erreur:
 ChoisirDossier = ""
 End Function

 Sub NOM()

 Dim FSO 'As Scripting.FileSystemObject
 Dim SourceFolder 'As Scripting.Folder
 Dim FileItem 'As Scripting.File
 Dim chemin$
 Dim T()
 Dim cpt&
 Dim g&
 Dim i&
 Dim j&
 Dim Lig&
 Dim var
 Dim WB As Workbook
 Dim S As Worksheet
 Dim DEST As Worksheet
 Dim Info(1 To 1, 1 To 26)
 '------------
 chemin$ = ChoisirDossier
 If chemin$ = "" Then Exit Sub
 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set SourceFolder = FSO.GetFolder(chemin$)
 If SourceFolder.Files.Count = 0 Then Exit Sub
 For Each FileItem In SourceFolder.Files
   If LCase(Right(FileItem.Name, 4)) = ".xls" Then
     cpt& = cpt& + 1
     ReDim Preserve T(1 To cpt&)
     T(cpt&) = chemin$ & "\" & FileItem.Name
   End If
 Next FileItem
 Set FileItem = Nothing
 Set SourceFolder = Nothing
 Set FSO = Nothing
 '------------
 Application.ScreenUpdating = False
 Set DEST = Sheets.Add
 Lig& = 1
 For g& = 1 To UBound(T)
   Set WB = GetObject(T(g&))
   Set S = WB.Sheets("NOM")
   Info(1, 1) = S.Range("f4")
   WB.Close
   Set WB = Nothing
   Lig& = Lig& + 1
   DEST.Range(DEST.Cells(Lig&, 1), _
         DEST.Cells(Lig&, UBound(Info, 2))) = Info
   Erase Info
 Next g&
 var = Array("NOM")
 With DEST
   .Range(.Cells(1, 1), .Cells(1, UBound(var) + 1)) = var
   .Range("a1").Interior.ColorIndex = 6
 End With
 Application.ScreenUpdating = False
 Exit Sub
Erreur:
 Application.ScreenUpdating = False
 MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description
 End Sub

Ces macros ont pour objectif de sélectionner le contenu de la cellule f4 de chaque fichier dans le dossier spécifié manuellement et de les mettre en colonne.

Après pour être tout à fait honnête je n'en comprends pas les 3/4 mais j'essaye...

Mon but est de : Indiquer un chemin d'accès (ex : C:\Users\etn\Downloads\PRENOM) pour chaque macro (un différent pour chaque macro), à la place de les sélectionner manuellement.

Et dans un 2e temps qu'elles s'exécutent en même temps (plutôt que de les lancer une par une), et si possible les avoir sur une feuille différente.

J'espère avoir été clair et si vous avez la moindre questions n'hésitez pas je répondrai le plus rapidement possible.

Merci d'avance.

 

[Dranreb]

Re : Spécifier chemin d'accès

Bonjour.
Ben vous n'avez qu'à chercher où est utilisée cette fonction ChoisirDossier et y remplacer son nom par une constante String qui exprime le chemin avec exactitude.
Si vous mettez Option Explicit en tête des modules vous n'avez qu'à mettre en commentaires les fonctions: il vous dira déjà où il ne reconnaitra plus les ChoisirDossier à remplacer.

 

[Etn]

Re : Spécifier chemin d'accès

Bonjour,

Tout d'abord merci de votre aide.

J'ai tenté de remplacer ChoisirDossier par mon chemin, mais erreur de syntaxe.
Je n'ai pas compris la 2e partie de votre message. Je dois taper option Explicit au tout début du code ? Et cela sert à savoir s'il manque des ChoisirDossier à remplacer ?

Et à propos de consolider les fichiers de différents dossiers (donc utiliser les macros les unes après les autres automatiquement) ?

Cordialement,

Etn

EDIT : Cela fonctionne en fait, je n'avais pas mis de guillemets avant et après le chemin.

Manque plus que la fonction qui permettrait de lier les 2 codes (ou un code qui permettrait de chercher dans plusieurs dossiers)

EDIT 2 : J'ai créé une macro qui lance les autres macros et ça à l'air de fonctionner.

Merci beaucoup pour votre aide !

 

[Dranreb]

Re : Spécifier chemin d'accès

Au lieu des parenthèse vides dans l'instruction Sub vous pouvez mettre Optional ByVal Dossier As String = "LeDossierParDéfaut", et dans son code vous utilisez Dossier à la place de votre constante String, celle ci ayant été déplacée vers l'instruction Sub comme étant "LeDossierParDéfaut".
Comme ça dans la macro qui la lance vous pouvez en spécifier un autre derrière son nom.

 

[Etn]

Re : Spécifier chemin d'accès

Le problème c'est qu'ajouter des dossiers ne suffirait pas, car le nom de la feuille est différent, la cellule également, puis il faudrait que les informations soient dans une nouvelle colonne (ou feuille), bref modifier énormément le code de base, ce qui est loin d'être à ma portée pour l'instant.

Merci quand même de m'avoir consacré de votre temps.

 

[Dranreb]

Re : Spécifier chemin d'accès

Vous pouvez passer plusieurs paramètres à une procédure. Y compris des objets comme ByVal Feui As Worksheet, ByVal Cel As Range etc.
En général ça simplifie la procédure, d'ailleurs. On ne s'y pose plus de question, c'est au programme appelant de se les poser !