Liens hypertextes changés suite à un crash

[Fab117]

Salut,
Grosse panique.
Depuis des semaines, je travaille sur un fichier excel.
Base de donnée avec des liens hypetexte vers des jpg ou des pdf.

Le fichier original se trouve sur mon PC principal.
Aujourd'hui, j'ai travaillé dessus depuis mon laptop (via réseau).
A un moment mon laptop m'a demandé à redémarrer suite à une mise à jour windows. Je lui ai dit d'attendre 1 heure. Et exactement une heure après il s'est éteint sans me prévenir et surtout sans me laisser fermer mon fichier Excel.
Après le reboot, le fichier Excel s'est ré-ouvert tout seul et semblait à jour.
J'ai directement fait une sauvegarde.

Ce n'est qu'après que j'ai testé les hypertextes et ... il avait changé les chemins d'accès.

Par exemple :
file:///F:\Utilisateurs\Commun\Inventaire\Photos\Reference1.JPG
est devenu :
file:///C:\Users\FabPackard\AppData\Roaming\Microsoft\Excel\Photos\Reference1.JPG

Quelqu'un saurait-il comment changer tous les liens :
file:///C:\Users\FabPackard\AppData\Roaming\Microsoft\Excel
par :
file:///C:\Users\FabPackard\AppData\Roaming\Microsoft\Excel

Merci d'avance.

Fab

 

[JCGL]

Re : Liens hypertextes changés suite à un crash

Bonjour à tous,

La mise à jour Win n'est pas à mettre en cause, à mon avis, pour la modification des liens.

Merci de modifier ta demande de changement de liens : il sont identiques.

A+ à tous

 

[Fab117]

Re : Liens hypertextes changés suite à un crash

Salut,
Merci pour ta réponse rapide.

J'ai effectivement fait un mauvais copier coller.
Actuellement, il a :
file:///C:\Users\FabPackard\AppData\Roaming\Microsoft\Excel\ ...
que je souhaiterais remplacer par :
file:///F:\Utilisateurs\Commun\Inventaire\ ...

Bon après-midi.

Fab

 

[JCGL]

Re : Liens hypertextes changés suite à un crash

Bonjour à tous,

Peux-tu essayer (sans conviction) :

Sub Test()
 Linkarray =  ActiveWorkbook.LinkSources(xlExcelLinks)
 For i = LBound(Linkarray) To  UBound(Linkarray)
If Linkarray(i) Like  "C:\Users\FabPackard\AppData\Roaming\Microsoft\Excel\" Then
ThisWorkbook.ChangeLink  Linkarray(i), "F:\Utilisateurs\Commun\Inventaire\",  xlLinkTypeExcelLinks
End If
Next i
End Sub

A+ à tous

 

[Fab117]

Re : Liens hypertextes changés suite à un crash

Resalut,
Malheureusement, il indique "Erreur d'xécution 13 Incompatibilité de type" sur la ligne "For i = LBound(Linkarray) To UBound(Linkarray)"

J'ai essayé une approche :

Sub Test22()
Dim h As Hyperlink
For Each h In ActiveSheet.Hyperlinks
Debug.Print h.Address;
MsgBox (h.Address)
Next
End Sub

Le MsgBox montre qu'il reprend bien l'adresse de l'hypertexte.

Sais-tu si avec une approche "Like" il est possible de remplacer
"C:\Users\FabPackard\AppData\Roaming\Microsoft\Excel\" par "F:\Utilisateurs\Commun\Inventaire\"

Merci

Fab

 

[Fab117]

Re : Liens hypertextes changés suite à un crash

Salut,
Help. J'ai vraiment passé beaucoup de temps à créer ces liens hypertextes.

Après des recherches sur google, J'ai essayé pas mal de trucs sans succès. Ils sont compilés ci-dessous :

Sub Test22()
Dim h As Hyperlink
For Each h In ActiveSheet.Hyperlinks
Debug.Print h.Address;
Lien = h.Address
'Lien.Text Replace(Lien.Text, "C:\Users\FabPackard\AppData\Roaming\Microsoft\Excel\", "F:\Utilisateurs\Commun\Inventaire\")
'h.Address.Text Replace(h.Address.Text, "C:\Users\FabPackard\AppData\Roaming\Microsoft\Excel\", "F:\Utilisateurs\Commun\Inventaire\")
'Lien.Value = Replace(Lien.Value, "C:\Users\FabPackard\AppData\Roaming\Microsoft\Excel\", "F:\Utilisateurs\Commun\Inventaire\")
Lien.Text = Replace(Lien.Text, "C:\Users\FabPackard\AppData\Roaming\Microsoft\Excel\", "F:\Utilisateurs\Commun\Inventaire\")
'Lien = Substitute(Lien, "C:\Users\FabPackard\AppData\Roaming\Microsoft\Excel\", "F:\Utilisateurs\Commun\Inventaire\")
' h.Address = Lien
Next
End Sub

J'arrive bien à récupérer le lien hypertexte, mais je n'arrive pas à faire l'échange de chaîne de caractère.

Quelqu'un aurait-il une idée ?

Bonne soirée.

Fab

 

[Fab117]

Re : Liens hypertextes changés suite à un crash

Ouf, j'y suis enfin arrivé (Merci google).
Pour info, voici le code :
Sub Modifier_lien_hypertexte()


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 = "C:\Users\FabPackard\AppData\Roaming\Microsoft\Excel\"

NewStr = "F:\Utilisateurs\Commun\Inventaire\"


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


Bonne nuit

Fab