modification de tous les lien du classeur

[obyone]

bonjour,

je dispose d'un classeur avec beaucoup de liens hypertextes, j'aimerais modifier par une macro à l'ouverture le début du chemin d'accès.

il doit passer de "Givers" à "C:" à l'ouverture du fichier.

j'ai essayé avec la macro suivante mais cela ne fonctionne pas.

Private Sub Workbook_Open()

Dim Doc As Workbook

Dim Cell As Range

Dim OldStr As String

Dim NewStr As String

Dim OldHp As String

Dim NewHp As String




OldStr = "G:\divers*"

NewStr = "C:*"

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






merci de votre aide

Oby1

 

[Regueiro]

Re : modification de tous les lien du classeur

Bonsoir

Code de Boisgontier

Option Explicit
Sub ModifieAddresse()
Dim NvRepertoire, h, a, nf
'si l'AncienRépertoire "c:\Mesdoc\ExcelMacroNouveau\1001exemples\"
  NvRepertoire = "G:\Mesdoc\ExcelMacroNouveau\1001exemples\"

  For Each h In ActiveSheet.Hyperlinks
    a = Split(Replace(h.Address, "\", "/"), "/")
    nf = a(UBound(a))
    h.Address = NvRepertoire & nf
  Next h
End Sub

 

[obyone]

Re : modification de tous les lien du classeur

bonjour,
merci Regueiro cela fonctionne

bonne journée

 

[obyone]

Re : modification de tous les lien du classeur

bonjour mauvaise nouvelle j'ai un petit problème

en faite je souhaite modifier le lien "\\128.60.1xxx.x\xxxxx\Documents techniques\Notes techniques x\x.pdf"
par "C:\Documents and Settings\Administrateur\Bureau\Documents techniques\Notes techniques x\x.pdf"

mais quand j'execute la macro

Sub ModifieAddresse()
Dim NvRepertoire, h, a, nf
NvRepertoire = "C:\Documents and Settings\Administrateur\Bureau\"

For Each h In ActiveSheet.Hyperlinks
a = Split(Replace(h.Address, "\", "/"), "/")
nf = a(UBound(a))
h.Address = NvRepertoire & nf
Next h
End Sub

mon lien devient
"C:\Documents and Settings\Administrateur\Bureau\x.pdf"

comment dois je modifier la macro

merci

 

[obyone]

Re : modification de tous les lien du classeur

re bonjour,

toujours des problemes

ce code si fonctionne

Sub macro()

Dim chemin_a_remplacer As String
Dim nouveau_chemin As String
Dim old_link As String
Dim old_text As String
Dim x As Range

chemin_a_remplacer = "xxxx" 'partie du chemin à remplacer
nouveau_chemin = "yyyyy" 'le nouveau chemin

For Each x In Selection.Cells

If x.Hyperlinks.Count > 0 Then
old_link = x.Hyperlinks(1).Address
old_text = x.Hyperlinks(1).TextToDisplay 'si nécessaire

x.Hyperlinks(1).Address = Replace(old_link, chemin_a_remplacer, nouveau_chemin)
x.Hyperlinks(1).TextToDisplay = Replace(old_text, chemin_a_remplacer, nouveau_chemin) 'si nécessaire

Else
End If
Next x


End Sub

mais uniquement lorque la cellule est selectionnée, j'aimerais le faire pour tout le classeur, mais ActiveSheet ne fonctionne pas?
comment puis je faire?