modification de tous les lien du classeur

obyone · 5 Avril 2016

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 · 6 Avril 2016

Re : modification de tous les lien du classeur

Bonsoir

Code de Boisgontier

Code:

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 · 6 Avril 2016

Re : modification de tous les lien du classeur

bonjour,
merci Regueiro cela fonctionne

bonne journée

obyone · 6 Avril 2016

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 · 6 Avril 2016

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?

modification de tous les lien du classeur

obyone

XLDnaute Occasionnel

Pièces jointes

Regueiro

XLDnaute Impliqué

obyone

XLDnaute Occasionnel

obyone

XLDnaute Occasionnel

obyone

XLDnaute Occasionnel

Discussions similaires