Macro Excel - Modif lien hypertexte

[Circus]

Bonjour,

 

J'aurai besoin d'un service, j'ai besoin d'une macro pour excel afin de changer une partie de lien hypertexte par une autre.

Suite a un changement d'emplacement sur le serveur, tous mes liens hypertexte sont invalides. J'ai donc besoin de remplacer le début du chemin par un autre.

 

Voici le lien actuel.

\\Serveur\Datas\Commercial\2008\....

 

Voila le nouveau lien.

\\Serveur\Datas\Bureau d'étude\10-Archives\2008\.....

 

Merci d'avance.

Circus

[Titifonky]

Bonjour,

 

Et ça ?

 

Il faut sélectionner les cellules à modifier.

 

Sub Modifier_lien()

Dim Doc As Workbook
Dim Cell As Range
Dim OldStr As String
Dim NewStr As String
Dim OldHp As String
Dim NewHp As String

'Chemin à modifier
OldStr = "\\Serveur\Datas\Commercial\2008\"
NewStr = "\\Serveur\Datas\Bureau d'étude\10-Archives\2008\"

Application.Calculation = xlManual

Set Doc = Application.ActiveWorkbook

For Each Cell In Selection

   'Verifie si la cellule contient des liens hypertexte
   If Cell.Hyperlinks.Count > 0 Then
       
       'Recupère l'adresse du lien sous forme de chaine
       OldHp = Cell.Hyperlinks(1).Address
       
       'Remplace l'ancienne chaine par la nouvelle
       NewHp = Replace(OldHp, OldStr, NewStr)
       
       'Supprime tous les liens hypertexte de la cellule
       Cell.Hyperlinks.Delete
       
       'Affecte le nouveau lien hypertexte
       Doc.ActiveSheet.Hyperlinks.Add Anchor:=Cell, Address:=NewHp
       
   End If

Next Cell

Application.Calculation = xlAutomatic

End Sub

 

Etienne

[Circus]

Merci beaucoup ! ca fonctionne parfaitement.

 

En plus avec les explications de chaque lignes j'ai pratiquement tout compris.

 

Merci encore !

 

Circus