VBA Remplacement nom de répertoire dans liens

Version imprimable

02/02/2017, 08h28
desatan

1 pièce(s) jointe(s)

VBA Remplacement nom de répertoire dans liens

Bonjour à tous le forum,

Je viens vers vous car malgré des tests, je n'arrive pas à trouver une macro qui irait dans tous les fichiers Excel des sous répertoires d'un répertoire donné pour modifier el lien de fichier lié.

Je joins un répertoire avec 2 fichiers pour être peut être plus claire.

Dans le répertoire test, 2 fichiers Excel.
Dans le premier, il y a un lien ='C:\Desktop\test\[fichier2.xlsx]Feuil1'!$A$1

Je cherche une macro qui pourrait parcourir les uns après les autres tous les fichiers excel du répertoire test et des sous répertoires et changer le lien ='C:\Desktop\test\[fichier2.xlsx]Feuil1'!$A$1 en ='D:\test\[fichier2.xlsx]Feuil1'!$A$1

Dans mes fichiers Excel j'ai plusieurs feuilles donc il faudrait que la macro parcours tout le document Excel.

Cette macro ne serait pas directement incluse dans le fichier à modifier, idéalement, en exécutant la macro, je souhaiterai qu'elle me propose de choisir le répertoire où il faudrait modifier les fichiers excel

Merci par avance pour votre aide.
02/02/2017, 09h11
Menhir

Si ton problème est de lister les fichiers de sous-répertoires, tu peux t'inspirer de ça :
https://excel.developpez.com/sources...scenceDossiers
https://excel.developpez.com/faq/?pa...BoucleFichiers
https://excel.developpez.com/faq/?pa...riptingRuntime
02/02/2017, 09h25
kiki29

Salut, à voir Liste des fichiers d'un dossier + Liens, à adapter à ton contexte.
02/02/2017, 09h36
desatan

Bonjour,

Merci pour vos réponses.

J'ai regardé vos 4 liens mais ils ne répondent pas à mon besoin.

Je ne veux pas lister les fichiers d'un répertoire.

Je souhaite que la macro ouvre chaque fichiers Excel d'un répertoire donné (y compris sous répertoire), par exemple C:\Desktop\test\, modifie dans ce fichier Excel les liens dans les formules, enregistre les modifications puis ferme le fichier. Ensuite elle passe au fichier suivant.

J'espère avoir été un peu plus claire, si ce n'est pas le cas, dites le moi.

Encore merci
02/02/2017, 09h47
Menhir

Citation:

Envoyé par desatan

Je ne veux pas lister les fichiers d'un répertoire.

Je souhaite que la macro ouvre chaque fichiers Excel d'un répertoire donné (y compris sous répertoire), par exemple C:\Desktop\test\, modifie dans ce fichier Excel les liens dans les formules, enregistre les modifications puis ferme le fichier. Ensuite elle passe au fichier suivant.

Bin... une fois que tu as la macro pour lister, au lieu de les afficher, tu les ouvres avec un Workbooks.Open (ce qui est facile une fois qu'on a le chemin et le nom).
Ensuite tu fais un For Each sur toutes les cellules du fichier.
Pour chacune, tu replaces la séquence que tu souhaites avec un Replace().
https://msdn.microsoft.com/fr-fr/lib.../gg264409.aspx

Ou, encore plus simple, lancer un Replace sur Cells du Workbook.
https://msdn.microsoft.com/fr-fr/lib.../ff194086.aspx
02/02/2017, 09h53
desatan
je viens de regarder ce bout de code
Code:

1 2 3 Worksheets("Sheet1").Columns("A").Replace _ What:="SIN", Replacement:="COS", _ SearchOrder:=xlByColumns, MatchCase:=True
J'aimerai que la macro regarde automatiquement toutes les feuilles des fichiers et toutes les cellules ?

Si je mets What:="C:\", Replacement:="D:\" cela suffit ?

Encore merci
02/02/2017, 10h03
Menhir

Citation:

Envoyé par desatan

Si je mets What:="C:\", Replacement:="D:\" cela suffit ?

Comme tu n'as pas décrit ce que tu veux remplacer et par quoi, difficile de répondre.
Le plus simple est d'essayer en te faisant une copie de quelques fichiers dans un répertoire test.

Citation:

J'aimerai que la macro regarde automatiquement toutes les feuilles des fichiers et toutes les cellules ?

Voir mon message précédent.
Il faut ouvrir les fichiers un par un (ne pas oublier de les fermer à la fin de la procédure pour ne pas être submergé).
Ensuite, lancer le Replace sur le Cells du Workbook référençant le fichier que tu viens d'ouvrir, ce qui représente l'ensemble de ses cellules.

Si si Menhir, dans mon premier message, j'avais préciser ce que je souhaitais remplacer, à savoir :

changer le lien ='C:\Desktop\test\[fichier2.xlsx]Feuil1'!$A$1 en ='D:\test\[fichier2.xlsx]Feuil1'!$A$

Je veux que dans tous mes liens de mes fichiers Excel, la macro change ='C:\Desktop\test\ en ='D:\test\

Merci de ton aide, pas simple quand on y connait pas grand chose

J'arriverai à ce code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Public Sub Ouvrir_Fichiers()
Dim wbFichierUsager As Workbook
Dim strFileName As String, strPath As String, strSpec As String
 
  Application.ScreenUpdating = False
  Set wbFichierUsager = ThisWorkbook
  strPath = "C:\Test"      
 strSpec = strPath & "*.xlsx"                
 
  strFileName = Dir(strSpec)
  Do While strFileName <> ""
    If strFileName <> wbFichierUsager.Name Then
      With Workbooks.Open(strPath & strFileName)
        '
       Cells.Replace What:="'C:\Desktop\test\", Replacement:= _
"'D:\test\", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False
       '
       .Close savechanges:=True     
     End With
    End If
    strFileName = Dir()
  Loop
End Sub

02/02/2017, 10h22
Menhir

Citation:

Envoyé par desatan

Si si Menhir, dans mon premier message, j'avais préciser ce que je souhaitais remplacer, à savoir :
changer le lien ='C:\Desktop\test\[fichier2.xlsx]Feuil1'!$A$1 en ='D:\test\[fichier2.xlsx]Feuil1'!$A$
Je veux que dans tous mes liens de mes fichiers Excel, la macro change ='C:\Desktop\test\ en ='D:\test\

Dans ce cas, n'as-tu pas l'impression qu'il manque quelque chose dans la What de ton code ?

Citation:

pas simple quand on y connait pas grand chose

Ca n'a rien d'une fatalité incurable.
http://bidou.developpez.com/article/VBA/
Donne un poisson à un homme qui a faim, tu le nourris pour la journée. Apprends lui a pêcher, tu le nourris pour la vie. :zen:

Citation:

J'arriverai à ce code :

Ca ressemble à des morceaux de code récupérés ici et là, mis ensemble sans recherche de cohérence.
As-tu essayer de comprendre ce que signifient ses éléments ?

Oui Menhir, j'essaye.

Je lance ce code, aucun message d'erreur mais le lien ne se change pas.
D'abord je lui indique le lien du répertoire où trouver les fichiers Excel
Ensuite je lui demande de faire la manip sur les liens
Puis je lui demande de sauvegarder avant de fermer
Et enfin de passer au prochain fichier Excel
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Public Sub Ouvrir_Fichiers() Dim wbFichierUsager As Workbook Dim strFileName As String, strPath As String, strSpec As String Application.ScreenUpdating = False Set wbFichierUsager = ThisWorkbook strPath = "C:\Desktop\Test" strSpec = strPath & "*.xlsx" strFileName = Dir(strSpec) Do While strFileName <> "" If strFileName <> wbFichierUsager.Name Then With Workbooks.Open(strPath & strFileName) ' Cells.Replace What:="'C:\Desktop\test\", Replacement:= _ "'P:\EXCEL\test", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _ False, SearchFormat:=False, ReplaceFormat:=False ' .Close savechanges:=True End With End If strFileName = Dir() Loop End Sub
Mon code avance.

La macro tourne et remplace bien ce que je veux dans les liens, il me reste 3 problèmes :

1) comment lui dire de répondre systématiquement au message box "ne pas mettre à jour" à l'ouverture du fichier
2) la macro ne descend pas dans les sous répertoires ?
3) la macro ne fait que la 1ère feuille du fichier Excel et elle ne fait pas toutes les feuilles ?

Merci par avance pour votre aide

02/02/2017, 13h00
Menhir

Citation:

Envoyé par desatan

1) comment lui dire de répondre systématiquement au message box "ne pas mettre à jour" à l'ouverture du fichier

Je pense qu'un DisplayAlert à False devrait suffire.
https://msdn.microsoft.com/fr-fr/lib.../ff839782.aspx
Ne pas oublier de le remettre à True juste après (il faudrait d'ailleurs aussi le faire avec le ScreenUpdating de ton code).

Citation:

2) la macro ne descend pas dans les sous répertoires ?

Voir les premiers lien que je t'ai donné.

Merci Menhir,

J'ai bien vu ce code dans tes liens mais je n'arrive pas à l'adapter

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
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 i As Long
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
 
    'Récupère le numéro de la dernière ligne vide dans la colonne A.
    i = Range("A65536").End(xlUp).Row + 1
 
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
        Cells(i, 1) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
        'Indique la date de création
        Cells(i, 2) = FileItem.DateCreated
        'Indique la date de dernier acces
        Cells(i, 3) = FileItem.DateLastAccessed
        'Indique la date de dernière modification
        Cells(i, 4) = FileItem.DateLastModified
        'Nom du répertoire
        Cells(i, 5) = FileItem.ParentFolder
 
        i = i + 1
    Next FileItem
 
 
    '--- 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