VBA mix de 2 macros

[31toto]

Bonjour tout le monde !

j'approche de mon but final grace à votre forum et aux personne qui m'ont beaucoup aidé et je vous en remerci !!!

Maintenant j'ai ces 2 macros que j'aimerais rassembler en une...
La 1ere liste les fichiers excel présent dans un dossier avec un lien hypertexte :

Sub Macro1()
With Application.FileSearch
' adresse du répertoire
.LookIn = "G:\TD\J\"
' type ou nom du fichier
.Filename = "*.xls"
' recherche dans les sous-dossiers
.SearchSubFolders = True
' executer la recherche
.Execute
' insertion dans le classeur excel
For I = 1 To .FoundFiles.Count
Cells(I + 5, 1) = .FoundFiles(I)
        With ActiveSheet
            .Hyperlinks.Add Anchor:=.Cells(I + 5, 1), _
            Address:=.Cells(I + 5, 1), _
            TextToDisplay:=.Cells(I + 5, 1).Value
            .Hyperlinks(I).ScreenTip = " VERS:" & .Cells(I + 5, 1).Value
        End With
Next I
End With
End Sub

et la 2eme permet de liste les fichiers présent dans le dossier ou le fichier se situe
et affiche les valeurs souhaité (A1, B1,...) :

Sub Affiche_valeurs()
Dim Chemin$, FName$
Dim Texto$, chiffres$, annee$, mois$, dater$
        Application.ScreenUpdating = False
    '------- liste les fichiers
        Chemin = ThisWorkbook.Path
        FName = Dir(Chemin & "\" & "*.xls")
    With Sheets("DT Synthèse")
            .Range("a5:e100").ClearContents
        Do While FName <> ""
            .Range("A65536").End(xlUp)(2) = FName
            .Range("b65536").End(xlUp)(2) = "='" & Chemin & "\" & FName & "'!A1"
            .Range("c65536").End(xlUp)(2) = "='" & Chemin & "\" & FName & "'!B1"         
            FName = Dir
        Loop
    End With
End Sub

En fait j'aimerais que la macro finale, liste les fichiers présent dans le dossier ou se trouve le fichier et aussi si il y a des sous dossiers, avec le lien hypertexte, et que ca aille lire la valeur (A1, B1,...) avec une chemin qui change..
G:\TD\J\06 , G:\TD\J\84 , G:\TD\J\33 , ...
Le plus de la 2eme macro c'est que le chemin n'est pas ecrit, jpeux deplacer le fichier n'importe ou ca marche, ca serait génial de garder ca mais ca me dérange pas de devoir écrire le début commun dans la macro...
Jespere que je suis assez clair et que vous pouvez m'aider les specialiste de VBA
Bonne journée !
Thomas

 

[31toto]

Re : VBA mix de 2 macros

J'ai reussi à faire ca...

Sub Macro1()
With Application.FileSearch
' adresse du répertoire
.LookIn = "G:\TEST"
' type ou nom du fichier
.Filename = "*.xls"
' recherche dans les sous-dossiers
.SearchSubFolders = True
' executer la recherche
.Execute
' insertion dans le classeur excel
For I = 1 To .FoundFiles.Count
Cells(I + 5, 1) = .FoundFiles(I)
        With ActiveSheet
            .Hyperlinks.Add Anchor:=.Cells(I + 5, 1), _
            Address:=.Cells(I + 5, 1), _
            TextToDisplay:=.Cells(I + 5, 1).Value
            .Hyperlinks(I).ScreenTip = " VERS:" & .Cells(I + 5, 1).Value
        End With
Next
Dim Chemin$, FName$
Dim Texto$, chiffres$, annee$, mois$, dater$
        Application.ScreenUpdating = True
    '------- liste les fichiers
        Chemin = ThisWorkbook.Path
        FName = I
    With Sheets("DT Synthèse")
        Do While FName <> ""
            .Range("e65536").End(xlUp)(2) = "='" & Chemin & "\" & FName & "'!A1"
            .Range("f65536").End(xlUp)(2) = "='" & Chemin & "\" & FName & "'!B1"
            FName = I
        Loop
    End With
End With
End Sub

mais je comprend pas le "80" et faudrait que ces formules soit à coté des liens hypertexte et que ca lise ce liens...
j'espere vous donner plus envi de m'aider..

 

[31toto]

Re : VBA mix de 2 macros

voilà un exemple avec 2 dossier et 2 fichier dans chaque mais yen a bien sur plus
et le fichier ou jaimerais en 1ere colonne, la liste des fichier present contenu dans tout les sous dossier
et qu'il affiche les valeurs comme le fichier "Affiche valeur" dans le dossier 06...
jespere que je reste clair...
j'aimerais combiné les deux macros
le fichier TEST 3 on voit le resultat des 2 mais il sont pas bien lié.. et j'arrive pas à le faire...