Modifier liens hypertexte automatiquement (nom serveur changé)

Brigitte

XLDnaute Barbatruc
Bonjour,

Il m'arrive une petite catastrophe. Un fichier excel précieux dans lequel j'ai mis des liens vers des fichiers (pdf et word, environ 400 sur deux onglets) d'un des répertoires du serveur boulot ne fonctionne plus.

Raison : le serveur vient d'être changé (sans qu'on soit prévenu bien sûr) et le chemin a changé.

Pour certains, ca s'est bien passé, pour moi non (la raison étant je pense que mon fichier, pour plus de sécurité était situé sur un répertoire serveur mais perso : G au lieu de L).

Bref personne pour m'aider ici... j'ai demandé, mais je crois qu'ils sont overbookés.

J'ai donc :

- identifié le problème (changement de chemin)
- déplacé mon fichier vers le répertoire serveur non perso (L)
- testé et refait certains liens, ca fonctionne... (au départ j'avais laissé le fichier sous G, ca ne marchait pas)

Mais voilà, même si j'ai trouvé comment faire :

- dans chaque cellule contenant un lien, faire insertion/lien hypertexte... je copie/colle la partie modifiée (au lieu de faire insertion et de remonter chaque fois l'arborescence très longue... )
- je préférerais de loin une astuce (macro ?) qui me balaie tous les liens contenant la partie ancienne et la remplace par la nouvelle, à savoir :

file:///\\NVINCT22\DIRECTIO\CHAMP_MARS\DIRECTIO..
par

file:///\\NVINCT25\DATA\DIRECTIO...

J'ai bien essayé par control F, mais ca ne marche que sur un contenu de cellule pas pour des liens.

Alors avant de tout me repalucher, si qqun avait la solution, ou avait rencontré le même problème, ca m'arrangerait.

Je ne peux pas mettre le fichier, vu que les liens pointeraient vers un serveur boulot, donc impossible à tester.

Merci beaucoup.
 

Pierrot93

XLDnaute Barbatruc
Re : Modifier liens hypertexte automatiquement (nom serveur changé)

Bonjour Brigitte:),

regarde peut être ceci, plage de cellule à adapter, traite la feuille active :
Code:
Option Explicit
Sub test()
Dim l As Hyperlink, c As Range
For Each c In Range("A1:A7")
    If c.Hyperlinks.Count > 0 Then
        Set l = c.Hyperlinks(1)
        l.Address = Replace(l.Address, "\NVINCT22\DIRECTIO\CHAMP_MARS\", "\NVINCT25\DATA\")
        l.TextToDisplay = Replace(l.TextToDisplay, "\NVINCT22\DIRECTIO\CHAMP_MARS\", "\NVINCT25\DATA\")
    End If
Next c
End Sub

bon après midi
@+
 
Dernière édition:

Brigitte

XLDnaute Barbatruc
Re : Modifier liens hypertexte automatiquement (nom serveur changé)

Bonjour le fil, coucou Pierrot,

Deux jours que je déprime littéralement !!!

Et tu sais quoi, ca marche, c'est trop énorme... Je t'adore mon Pierrot, tu me sauves tout le temps...

Je te fais mille bisous...

Merci, merci, merci...
 

st007

XLDnaute Accro
Re : Modifier liens hypertexte automatiquement (nom serveur changé)

Bonjour,
une idée
sub essailien()

txt1 = "\NVINCT22\DIRECTIO\CHAMP_MARS\"
txt2 = "\NVINCT25\DATA\"
For Each lnk In ActiveSheet.Hyperlinks
If lnk.Type = 1 And InStr(lnk.Address, txt1) Then
lnk.Address = Replace(lnk.Address, txt1, txt2)
compteur = compteur + 1
End If
Next
MsgBox compteur & " liens trouvés et modifiés"
end sub

ou bien
Sub essailien()
Dim hypLink As Hyperlink
Dim ws As Worksheet

For Each ws In Worksheets
For Each hypLink In ws.Hyperlinks
If hypLink.Address Like "file:///\\NVINCT22\DIRECTIO\CHAMP_MARS\*" Then
hypLink.Address = _
Replace(hypLink.Address, "file:///\\NVINCT22\DIRECTIO\CHAMP_MARS\", "file:///\\NVINCT25\DATA\")
End If
Next hypLink
Next ws
End Sub
 

Brigitte

XLDnaute Barbatruc
Re : Modifier liens hypertexte automatiquement (nom serveur changé)

Merci à toi aussi st007... j'enregistre en mode "bloc commentaire" ta macro bien au chaud dans mon module sous celui de Pierrot.

Bises comme promis.
 

Discussions similaires

Haut Bas