Discussion :

[Denis_67]

Bonjour,

Suite à une reorganisation IT, on nous impose de changer notre serveur bureautique.

Or il existe des fichiers Excel utilisés par les utilisateurs comme base documentaire avec des miliers de lien hypertexte.

Pour assurer la migration, je compte proposer une macro que l'utilisateur pourrait faire tourner afin de remplacer le nom du serveur dans le lien hypertexte.

Le lien actuel est du type

file:///\\monserveur\monrepertoire\monsousrepertoire\monfichier.xls

J'ai donc trouvé ce tuto et l'ai appliqué en bouclant sur toutes les feuilles d'un classeur.

http://excel.developpez.com/faq/inde...placeTermeLien

Malheureusement la macro s'exécute mais ne fait rien.
J'ai ajouté un debug print et le problème vient que .adress me renvoie le nom du fichier et pas le chemin. quelle commande autre que .adress me donera le lien entier ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Sub modif_liens()
Dim Hpk As Hyperlink
Dim strLien As String
 
    For i = 1 To Sheets.Count
        For Each Hpk In Worksheets(i).Hyperlinks
            strLien = Hpk.Address
Debug.Print strLien
            Hpk.Address = Replace(strLien, "monrepertoire", "mon_nouveau_repertoire")
        Next Hpk
    Next i
End Sub

Merci

[Invité]

Bonjour,

Un exemple de solution utilisée pour mes fichiers journaliers de météo. Le code est à adapter à votre cas.

Le principe est d'aller vérifier la présence ou non du fichier dans le répertoire de sauvegarde désigné et de reconstituer le lien le cas échéant.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
Option Explicit
 
Public MyFile As String
Public SeparateurMois As String
Public SeparateurJours As String
 
Public Cellule As Range
 
Public ColDateReleve As Long
Public ColDonneesImportees As Long
Public ColLienHypertexte As Long
Public ColTemperatureMax As Long
Public ColRepertoireSauvegarde As Long
 
Public LigneDeTitre As Long
Public DerniereLigne As Long
 
Public ShStationMeteo As Worksheet
 
 
Sub MaJLesLiensHypertextes()
 
' Cette macro permet de mettre à jour les liens lorsque les fichiers ont changé de place ou de disque dur.
 
 
       Set ShStationMeteo = ActiveSheet
       '-----------------------------------------------------------
       ' Sélection du répertoire de stockage des fichiers d'analyse
       '-----------------------------------------------------------
        With UserFbChoixRepertoire
 
            .TextRepertoire = ShStationMeteo.Range("RepertoireDeSauvegarde")
            .Show
 
        End With
 
        '----------------------------------
        ' Mise à jour des liens hypertextes
        '----------------------------------
        If Continuer = True Then
 
            EtablirLesLiensHypertextesAvecLesFichiersMeteo ShStationMeteo
 
            MsgBox ("Fin de programme !")
 
        End If
 
       Set ShStationMeteo = Nothing
 
End Sub
 
 
 
Sub EtablirLesLiensHypertextesAvecLesFichiersMeteo(ByVal FeuilleMeteo As Worksheet)
 
Dim CtrJ As Long
Dim AireDateReleve As Range
 
        Application.ScreenUpdating = False
        FeuilleMeteo.Activate
        LigneDeTitre = 10
 
        ColDateReleve = ColonneReleves(LigneDeTitre, "Date")
        ColDonneesImportees = ColonneReleves(LigneDeTitre, "Importé")
        ColLienHypertexte = ColonneReleves(LigneDeTitre, "Hyperlien fichier météo")
        ColTemperatureMax = ColonneReleves(LigneDeTitre, "Température maximale")
        ColRepertoireSauvegarde = ColonneReleves(LigneDeTitre, "Répertoire de sauvegarde")
 
        With FeuilleMeteo
 
            DerniereLigne = .Cells(.Rows.Count, ColTemperatureMax).End(xlUp).Row
 
            Set AireDateReleve = Range(.Cells(LigneDeTitre + 1, ColDateReleve), .Cells(DerniereLigne, ColDateReleve))
 
            For Each Cellule In AireDateReleve
 
                   If Cellule.Offset(0, ColLienHypertexte - ColDateReleve) = "" And Cellule.Offset(0, ColDonneesImportees - ColDateReleve) = "Importé" Then
                        Cellule.Select
                        Select Case Month(Cellule)
                               Case Is < 10
                                    SeparateurMois = "-0"
                               Case Else
                                    SeparateurMois = "-"
                               End Select
 
                        Select Case Day(Cellule)
                               Case Is < 10
                                    SeparateurJours = "-0"
                               Case Else
                                    SeparateurJours = "-"
                        End Select
 
                        NomSauvegardeFichier = "Infoclimat-fr " & .Range("SauvegardeStationMeteo").Value & " " & Year(Cellule) & SeparateurMois & Month(Cellule) & SeparateurJours & Day(Cellule) & ".xlsm"
 
                        RechercheFichier .Range("RepertoireDeSauvegarde"), FeuilleMeteo, NomSauvegardeFichier
                  End If
            Next Cellule
 
            Set AireDateReleve = Nothing
 
        End With
 
        Application.ScreenUpdating = True
 
End Sub
 
 
Sub RechercheFichier(DossierRacine As Variant, FeuilleDuLien As Worksheet, NomDuFichierATrouver As Variant)
 
Dim Fso As Object
Dim Dossier As Object
 
  Set Fso = CreateObject("Scripting.FileSystemObject")
  Set Dossier = Fso.getfolder(DossierRacine)
 
  MyFile = Dir(Dossier.Path & "\*.*")
 
  Do While MyFile <> ""   ' Commence la boucle.
 
      If NomDuFichierATrouver = MyFile Then
              FeuilleDuLien.Hyperlinks.Add Anchor:=Cellule.Offset(0, ColLienHypertexte - ColDateReleve), Address:=Dossier.Path & "\" & MyFile, TextToDisplay:=MyFile
              Cellule.Offset(0, ColRepertoireSauvegarde - ColDateReleve) = Dossier.Path
      End If
 
      MyFile = Dir   ' Extrait l'entrée suivante.
 
  Loop
 
 
  Set Dossier = Nothing
  Set Fso = Nothing
 
End Sub

Cordialement.

[Denis_67]

Merci Eric,

Je vais tester pour voir ce que ça donne en adaptant.
Je pars en déplct je ne mettrai le statut résolu que dans 10 jours
Denis

[Denis_67]

Bonjour,

Merci à Eric pour sa proposition qui n'était pas applicable à mon cas (scan de plusieurs miliers de répertoires sur un lecteur réseau et risque de doublons).

En fait le problème est un problème d'adresse relative, quand Excel n'a pas d'information contraire il ne montre que le chemin réduit

J'ai suivi les propositions faites ici
http://www.developpez.net/forums/d13...elatif-absolu/

D'abord la solution de Micorsoft de mettre en x ou X dans le répertoire web des propriétés du classeur ne fonctionne pas (jusqu'à preuve du contraire !).

Par contre le fait de désactiver la mise à jour des liens, fonctionne
si le fichier classeur contenant la macro n'est pas dans le même répertoire que les fichiers appelés par les liens
c'est cette nuance dans le monde du chemin relatif qui m'a perturbé.

Donc en créant un macro spécifique de mise à jour dans un classeur sauvegardé dans un emplacement quelconque isolé des fichiers liés ,par exemple le bureau, on peut mettre à jour les liens de tous les classeurs et toutes les feuilles et tous les liens ave la macro proposée au début du post.

Denis