VBA mix de 2 macros

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

-- 02 Juin 2010, 11:29 --

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..

Bonjour,

Peu d'explications, pas de fichier = pas de réponse

mais je comprend pas le "80"

Tu parles de quoi et c'est où dans le code ?

Ta demande se résume un peu comme si tu me demandais de chercher une aiguille dans un botte de foin mais que tu me donnes pas la botte de foin. Tu vois ce que je veux dire là ?

Dans ton code cette ligne ne sert à rien -->

 Dim Texto$, chiffres$, annee$, mois$, dater$

A bientôt

désolé je pensais que ca suffirait

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...

re,

Ok toto31, merci de ton fichier. Je regarde.

Amicalement

merci

j'ai reussi à faire ca ce matin :

Sub Macro1()
  With Sheets("DT Synthèse")
  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
        Chemin = ThisWorkbook.Path
  For I = 1 To .FoundFiles.Count
  FName = Cells(I + 5, 1)
        Do While FName <> ""
            .Range("e65536").End(xlUp)(2) = "='" & Chemin & "\" & FName & "'!A1"
            .Range("f65536").End(xlUp)(2) = FName & "'!A1"
            .Range("g65536").End(xlUp)(2) = FName & "'!B1"
            FName = Dir
        Loop
Next
End With
End With
End Sub

mais je comprend pas la ligne

Range("f65536").End(xlUp)(2)

je voudrais A1 dans la colonne F,...

toto31 Bonjour,

Une macro étant à chaque fois spécifique,

çà ne sert pas à grand chose d'afficher des bouts de code pompé çà et là !

expose ton problème, c'est tout

Amicalement

Claude

j'ai cette macro dans le ficheir TEST 5

je cherche à afficher les valeur qui ya dans les cellules A1 et B1 de tout les fichiers contenu dans les dossier 06, ...

la début de la macro sort la liste des fichiers présent avec lien hypertexte

et la deuxieme jaimeré quelle lise ce lien et affiche la valeur souhaité

(formule du type copier coller avec liaison :

='C:\Documents and Settings\TT\Desktop\TEST\06\[06_JB1025_00.xls]DT CC'!A1

c'est plus clair ?

Re,

Bon il me semble que tu ne lis pas cee que je t'écris puisque je retrouve de nouveau la ligne de déclaration de variables qui ne sert à rien dans ton fichier.

De plus la varialble "i" n'est pas non plus déclarée.

je cherche à afficher les valeur qui ya dans les cellules A1 et B1 de tout les fichiers contenu dans les dossier 06 ....... ='C:\Documents and Settings\TT\Desktop\TEST\06\[06_JB1025_00.xls]DT CC'!A1

Contradiction là.. tu veux A1, B1 ou les deux ?

Ton code est incorrecte pour avoir cela.

Bizarre mais il me semble que j'avais donné à Claude Dubois, une solution pour cela dans un fil précédent.

Salut Dan,

Oui, c'était ce fil

https://forum.excel-pratique.com/excel/vba-syntaxe-t17458.html#p100345

Claude

Re,

Ok merci Claude (tu veilles au grain je vois...)

Bon toto31, cela ne sert à rien de te donner des indications si tu ne les appliques pas dans tes fichiers. Que ce soit dans ce fil ou celui donné par Claude, aucune des propositions ne sont appliquées dans le code de ton fichier ...

Si tu veux une solution, tu mets juste un simple fichier (pas le fichier TEST on l'a déjà !) avec une feuille et des données (dans les bonnes colonnes) de ce que tu veux obtenir.

Ici on voit que le lien hypertexte est en colonne A à partir de la ligne 6. Le nom du fichier et A1 et B1, tu les veux en correspondance avec le lien hypertexte ou ailleurs ??

A te relire

oui pour la ligne qui sert à rien je pensais lavoir supprimer mais comme je fait plein de test, jai du reprendre une ou je lavais pas surpimer, mais cest noté je l'enleveré. Desolé

et j'ai vu pour les crochets mais la pluspart sont nommée mais maintenant je peux faire les deux, merci !

ce que j'essai de faire, c'est cette macro qui est super bien mais jaimerais quelle prene aussi les sous dossiers

et à coté javais cette macro qui sort la liste des fichiers sous dossier compri avec en plus le liens hypertexte

je cherhce à combiner les 2 si c'est possible... vous voyez ce que je veux dire ?...

-- 03 Juin 2010, 12:55 --

et là je bug à ce niveau là :

mais je sais pas si cest la bonne méthode mais ca marche presque...

-- 03 Juin 2010, 13:27 --

pour répondre plus preci à DAN

en colonne A, a partir de A6 j'ai la liste de fichier avec liens qui se crée

et jaimerais dans chaque colonne que ca affiche ca :

='G:\TEST\06\06_JB1025_00.xls'!BV avec la fin qui change : BV, CCP,...

j'y suis presque...

voilà ce que j'aimerais, et là ou j'en suis :

-- 03 Juin 2010, 14:45 --

ca se precise

jespere qu'avec ce que je vous envoi maitenant, vous comprendrez mieux maitenant..

mon probleme maintenant c'est que la boucle s'arrete pas.. il faudrait que ca sarrete qd ya plu de liens dans la colonne A...et comment faire pour que les valeurs affiché soit en face des liens ?

voilà ou j'en suis :

merci d'avance c'est bientot fini !!!

Re,

Mais c'est incroyable !! je constate de nouveau que tu ne lis pas ce que je t'écris !

De plus 7 fichiers dans un seul post !!! Je suis sidéré

Désolé mais je n'ai pas besoin de revoir sans cesse ton code et on fichier Test mais uniquement ce que je t'ai demandé dans le post précédent. Dans le cas contraire je suis au regret de te dire que je laisse tomber.

Et surtout ne mets plus ton fichier TEST avec la série de fichiers qu'il comporte !!! avec le nombre d'exemplaire sur ce fil on n'en a pas besoin

A bientôt

excuse moi mais j'essai juste de vous montrer la progression de la macro...

voila ce que je veux :

sauf que là, ya juste la macro qui affiche les valeurs et une autre pour créer le lien à partir du nom du fichier

la macro dans le fichier TEST 7 fait les 2 en meme temps mais c'est juste pas en face et ca boucle sans s'arreter..

apres que ca commence en ligne 6 ou 4 ca m'est égal, mais que ca soit en face juste

jespere que cette foi ca ira...

merci de votre patience !

bonne journée

Re,

Merci pour le fichier.

Peux-tu me donner les réponses aux questions ci-dessous

Question 1 :

Je vois donc le code avec le résultat suivant :

• Colonne A : un lien hypertexte qui te permet d'ouvrir le fichier
• Colonne B : le nom du fichier correspondant au lien hypertexte de la colonne A
• Colonne C : la valeur trouvée en A1 du fichier correspondant au lien hypertexte de la colonne A
• Colonne D : la valeur trouvée en B1 du fichier correspondant au lien hypertexte de la colonne A

Exemple pour le fichier 06_JB1025_00.xls

Colonne A : lien hypertexte vers le fichier 06_JB1025_00.xls

Colonne B : nom du fichier 06_JB1025_00.xls

Colonne C : valeur A1 trouvée dans le fichier 06_JB1025_00.xls

Colonne D : valeur B1 trouvée dans le fichier 06_JB1025_00.xls

Question 2 :

Le fichier TEST et les dossiers 06, 25 etc sont toujours placés dans le même dossier ici appelé TEST ??

Question 3 :

Les fichiers 06_JB1025_00.xls, etc... comporte toujours une seule feuille ?? (ici je vois le nom DT CC)

Merci de me répondre sur ces question et surtout sans me mettre un fichier.

A te relire

promis plus de fichier !

alors :

Q1

alors j'ai besoin que du liens plus du nom si jai le liens direct, donc :

Colonne A : lien hypertexte vers le fichier 06_JB1025_00.xls

Colonne B : valeur de la cellule A1 qui est nommée STP par exemple...trouvée dans le fichier 06_JB1025_00.xls

Colonne C : CCP

Q2

oui j'ai un dossier "TEST1" par exemple et dans celui là, j'ai plein de dossier 06, 64,...

et un autre "TEST2" et là 33, 95,...

mais jai besoin de changé ce nom, jai plusieur dossier..

Q3

tout mes fichiers 06_JB1025_00.xls ont un onglet "DT CC" oui et les celluls nommées

voila

Re,

Remplace ton code par celui-ci dessous :

Sub Macro1()
Dim i As Integer
Dim fs As Object
Dim fname
Call suppr_tableau
With Application.FileSearch
' adresse du répertoire
.LookIn = ThisWorkbook.Path '"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)
Set fs = CreateObject("Scripting.FileSystemObject")
Set fname = fs.GetFile(.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
            .Cells(i + 5, 2) = fname.Name
            .Cells(i + 5, 3) = "='" & fname & "'!A1"
            .Cells(i + 5, 4) = "='" & fname & "'!B1"
        End With
Next
End With
End Sub

Le code appellera la macro Supp_Tableau pour effacer tes données avant de remettre les nouvelles.

A te relire (toujours sans fichier..)

c'est parfait dan !!!

en plus c'est bcp plus clair avec ca Cells(i + 5, 3) =

rien à redire cest parfait !!!

merci beaucoup !!!

par contre desfois ca affiche "0" alors que ya bien du texte dans la cellule...?

tu crois que c'est possible de faire quelque chose ? ou pas...

re,

par contre des fois ca affiche "0" alors que ya bien du texte dans la cellule...?

A priori je ne vois pas le pourquoi mais lorsque tu as 0, tu as quoi comme nom de fichier en colonne B ?

La structure de ton répertoire devrait être :

• Dossier 06
• Dossier 25
• Dossier xx
• - Fichier Test

Si tu as d'autres fichiers au même niveau que le fichier Test, cela peut te donner un 0 en colonne B et C.

A te relire

oui ca c'est ok

enfait tout marche avec mes fichiers 06_JB1025_00.xls

mais les 33_JH3169_00.xls c'est bizarre, quand jai lancé la macro la 1ere foi il a affiché les cellules BV et E1E1 mais pas PNEU et là jre essai et ca affiche PNEU et E1E1 mais pas BV... c'est super bizarre...

re,

Vérifie que tu n'as pas un fichier qui traine et qui ne contient pas d'info ezt vérifie que tu as bien une seule feuille dans les fichiers sauvegardés.

Si ton souci est terminé, merci de le cloturer en cliquant sur le V de couleur Vert à coté du bouton editer

A bientôt