Macro recherche de fichiers en fonction de chemin,texte,extension

Emmanuel31 · 1 Août 2011

Bonjour à toutes et à tous !

J'ai trouvé sur internet une macro qui permet de rentrer 3 paramètres (chemin, texte, extension) et ainsi en l'exécutant de créer un lien hypertexte du ou des fichiers avec l'extension demandée et contenant le texte demandé dans le chemin demandé.

En gros et pour faire simple si vous mettez :
- chemin : C:\test\
- texte : test1
- extension : .xls
la macro vous créra le ou les liens vers tous les fichiers excel dans C:\test contenant en titre le nom de test1

Là ou je sollicite votre aide, c'est concernant la modification de cette macro ...

Je souhaite faire fonctionner cette macro en boucle à partir de cellules contenant le texte à chercher.

c-a-d en
- A1 : le texte est "test1"
- A2 : le texte est "test2"
- A3 : le texte est "test3"

Le but étant d'avoir en B1 B2 et B3 les liens fichiers correspondants.

Y'a-t-il un expert dans le coin qui pourrait m'aider svp ?

Merci !

Emmanuel31 · 3 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Salut Softmama !

Aller, encore un dernier effort et j'y suis !

J'ai donc modifier en ceci :

Code:

  If c <> "" And Left(c, 1) = "1" And c.Hyperlinks.Count = 0 Then

En effet, j'ai rajouté le fait que la sélection commence par 1 car ce que je recherche commence forcément par 1 , et cela m'évite que le script ne passe sur les cellules avec le titre (via des cellules fusionnées).

J'en suis maintenant à un cas de figure spécial !

Le cas d'un fichier qui est dans "C:\test\test a valider\" (c'est le seul sous-répertoire).
Avec le script, le lien est créé dans le sous répertoire, pas de problème.
Mais le script ne repasse plus vu que lien existe déjà ...

OR tout ce qui est dans "C:\test\test a valider\" est amené à être validé et à passer dans "C:\test\" .

Une idée du code à rajouter dans

Code:

  If c <> "" And Left(c, 1) = "1" And c.Hyperlinks.Count = 0 Then

pour rajouter un test sur le lien hypertexte afin de voir s'il contient "test a valider" , et s'il le contient -> exécution ?????

Softmama · 3 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

j'ai rien compris
??

Emmanuel31 · 3 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Hihihi ...

La macro sur laquelle tu m'as aidé hier fonctionne très bien (voir page d'avant de ce même post).

J'aimerais juste rajouter un test à

Code:

If c <> "" And Left(c, 1) = "1" And c.Hyperlinks.Count = 0 Then

Le test serait (en français ;-) et en plus des conditions ci-dessus) :

-> si l'hyperlien de c contient "\test a valider\"
cad au final :

If c <> "" And Left(c, 1) = "1" And c.Hyperlinks.Count = 0 And hyperlien c contient "\test a valider\" Then

Mais je en sais pas traduite le texte en rouge en code ... :-(

Softmama · 3 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

remplace le texte en rouge par

VB:

instr(c.hyperlinks(1).address, "\test a valider\") > 0

Softmama · 3 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

heu ceci dit, c'est pas compatible avec la condition:

VB:

c.Hyperlinks.Count = 0

Je pense que ce que tu cherches à faire serait plutôt ceci :

VB:

If c <> "" And Left(c, 1) = "1" Then
  If  c.Hyperlinks.Count = 0 Then
     '... traiter
  elseif instr(c.hyperlinks(1).address, "\test a valider\") > 0 Then
     '..traiter
  end if
end if

en collant Traiter dans une sub à part

Emmanuel31 · 3 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Code:

If c <> "" And Left(c, 1) = "1" And c.Hyperlinks.Count = 0 And InStr(c.Hyperlinks(1).Address, "\TEST A VALIDER\") > 0 Then

Ça ne marche pas

Softmama · 3 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

ben oui, c'est ce que je t'ai dit au post précédent : tu veux d'une part pour traiter la cellule, qu'il n'y ait pas déjà de lien (c.Hyperlinks.Count = 0) et aussi que l'adresse du lien comprenne \test a valider\ (InStr(c.Hyperlinks(1).Address, "\TEST A VALIDER\") > 0 ) ... Ca n'est pas compatible. Par ailleurs, attention car tu avais noté en minuscule dans le post précédent et dans la macro tu l'as mis en majuscule, la casse a son importance comme c'est formulé. Pour se passer de la casse, note ainsi :
InStr(ucase(c.Hyperlinks(1).Address), "\TEST A VALIDER\") > 0

Emmanuel31 · 3 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Pardon je n'avais pas vu le second post ...

Je vais donc partir du code que tu cites et essayer de l'adapter à mon besoin ...

Merci !

Emmanuel31 · 3 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Merci encore !!
Ça marche impec !!!

Bon aller , je continue à chercher un module de barre de progression ;-)

Softmama · 3 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Pour la progression, c'est assez simple :
le % d'effectué, tu l'obtiens par :

Code:

100 * (c.row - 6) / ( d.row - 6)

Emmanuel31 · 3 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Je ne saurais pas le faire ...
Je regarde des tutoriels mais ça à pas l'air simple ...

Après je me dis qu'une barre de progression va p'tet consommer de la mémoire et du proc et donc du temps, tout ça pour afficher une barre défilante ...

P'tet que je vais uniquement afficher un UserForm avec un texte genre "traitement en cours" et fermer ce UserForm une fois terminé pour afficher une MsgBox comme quoi c'est terminé ...

Qu'en penses-tu ?

Softmama · 3 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Ben cette une bonne solution cet userform (à afficher en non modal). T'y colle un label dedans et tu ajoutes cette ligne de code :

Au départ:

VB:

Userform1.show 0

et à chaque changement de c, Avant la ligne

VB:

If c <> "" And Left(c, 1) = "1" Then

tu ajoutes :

VB:

Userform1.Label1.Caption = "% effectué : " & 100 * (c.row - 6) / ( d.row - 6)

Puis en fin de macro

VB:

Unload Userform1

Emmanuel31 · 4 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Merci pour l'info ...

Mais je dois louper quelque chose ...

Voici mon code :

VB:

Sub MAJ()
   
  'Appelle la procédure de recherche des fichiers
UserForm1.Show 0
 ListeFichiers [Parametres!A2]
Unload UserForm1
  MsgBox "Mise à jour des liens terminée"
End Sub
Sub ListeFichiers(Repertoire As String)
 
 'Nécessite d'activer la référence "Microsoft Scripting RunTime"
     'Dans l'éditeur de macros (Alt+F11):
     'Menu Outils
     'Références
     'Cochez la ligne "Microsoft Scripting RunTime".
     'Cliquez sur le bouton OK pour valider.

    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim c As Range, d As Range
   
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
   
Set c = [A1]: Set d = [A500].End(xlUp)(2, 1)
'Boucle sur tous les noms de fichiers de la colonne A
Do While c.Address <> d.Address
    
'Si la cellule n'est pas vide et dont la valeur commence par un "1"
If c <> "" And Left(c, 1) = "1" Then
UserForm1.Label1.Caption = "% effectué : " & 100 * (c.Row - 6) / (d.Row - 6)
For Each FileItem In SourceFolder.Files
  'Si la cellule ne contient pas de lien hypertexte
  If c.Hyperlinks.Count = 0 Then
        If FileItem.Name Like "*" & c & "*" & [Parametres!A4] Then
            'Ajoute un lien hypertexte vers le fichier
         ActiveSheet.Hyperlinks.Add Anchor:=c, _
              Address:=FileItem.ParentFolder & "\" & FileItem.Name
        End If
  'Si la cellule contient un lien hypertexte contenant le chemin "TEST A VALIDER"
  ElseIf InStr(c.Hyperlinks(1).Address, "\TEST A VALIDER\") > 0 Then
        If FileItem.Name Like "*" & c & "*" & [Parametres!A4] Then
            'Remplace le lien hypertexte vers le chemin définitif
         ActiveSheet.Hyperlinks.Add Anchor:=c, _
              Address:=FileItem.ParentFolder & "\" & FileItem.Name
        End If
 End If
 Next FileItem
End If
    Set c = c(2, 1)
Loop
   
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
 For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
 
End Sub

Et au final j'ai un userform "vide" (voir fichier joint)

Softmama · 4 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Bonjour,
Tu as bien mis un label dans ton userform. Il s'appelle bien label1 ?? La couleur de police de ce label est bien différente de celle du fond ??
Essaie cette modification, sinon :

VB:

Sub MAJ()
   
  'Appelle la procédure de recherche des fichiers
UserForm1.Show 0
 ListeFichiers [Parametres!A2]
Unload UserForm1
  MsgBox "Mise à jour des liens terminée"
End Sub
Sub ListeFichiers(Repertoire As String)
 
 'Nécessite d'activer la référence "Microsoft Scripting RunTime"
    'Dans l'éditeur de macros (Alt+F11):
    'Menu Outils
    'Références
    'Cochez la ligne "Microsoft Scripting RunTime".
    'Cliquez sur le bouton OK pour valider.

    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim c As Range, d As Range
   
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
   
Set c = [A1]: Set d = [A500].End(xlUp)(2, 1)
'Boucle sur tous les noms de fichiers de la colonne A
Do While c.Address <> d.Address
  UserForm1.Label1.Caption = "% effectué : " & 100 * (c.Row - 6) / (d.Row - 6)
  Userform1.Repaint
   
'Si la cellule n'est pas vide et dont la valeur commence par un "1"
If c <> "" And Left(c, 1) = "1" Then
For Each FileItem In SourceFolder.Files
  'Si la cellule ne contient pas de lien hypertexte
 If c.Hyperlinks.Count = 0 Then
        If FileItem.Name Like "*" & c & "*" & [Parametres!A4] Then
            'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=c, _
              Address:=FileItem.ParentFolder & "\" & FileItem.Name
        End If
  'Si la cellule contient un lien hypertexte contenant le chemin "TEST A VALIDER"
 ElseIf InStr(UCase(c.Hyperlinks(1).Address), "\TEST A VALIDER\") > 0 Then
        If FileItem.Name Like "*" & c & "*" & [Parametres!A4] Then
            'Remplace le lien hypertexte vers le chemin définitif
        ActiveSheet.Hyperlinks.Add Anchor:=c, _
              Address:=FileItem.ParentFolder & "\" & FileItem.Name
        End If
 End If
 Next FileItem
End If
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
Next SubFolder
     Set c = c(2, 1)
Loop
   

End Sub

Tiens-moi au courant de ce que ça donne.

Emmanuel31 · 4 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Oula ....

Ça "marche" dans le sens ou je vois bien le UserForm avec un truc qui défile dedans ...

Mais ça défile de 0 à 100% (avec près de 15-20 décimales) puis ça passe à genre -2% (ou -3) puis ça refait jusqu’à 100% etc ...

Et j'ai l'impression que ça mets plus de temps qu'à l'accoutumée !

Macro recherche de fichiers en fonction de chemin,texte,extension

Emmanuel31

XLDnaute Occasionnel

Pièces jointes

Emmanuel31

XLDnaute Occasionnel

Softmama

XLDnaute Accro

Emmanuel31

XLDnaute Occasionnel

Softmama

XLDnaute Accro

Softmama

XLDnaute Accro

Emmanuel31

XLDnaute Occasionnel

Softmama

XLDnaute Accro

Emmanuel31

XLDnaute Occasionnel

Emmanuel31

XLDnaute Occasionnel

Softmama

XLDnaute Accro

Emmanuel31

XLDnaute Occasionnel

Softmama

XLDnaute Accro

Emmanuel31

XLDnaute Occasionnel

Pièces jointes

Softmama

XLDnaute Accro

Emmanuel31

XLDnaute Occasionnel

Discussions similaires