Préserver liens hypertextes
Bonjour à tous,
J'ai créé un fichier Excel qui sert de plateforme principale pour accéder à une multitude d'autres fiches via des liens hypertextes.
Le principe est qu'à chaque ligne correspond une fiche. Cette fiche est répertoriée dans un dossier nomme "base de données" qui est inaccessible a priori.
J'ai un fonction, qui permet de créer une nouvelle ligne dans mon fichier, et d'y associer directement une nouvelle fiche (celle-ci se crée, et se range dans le dossier "base de données"), le lien est directement fait.
Évidemment, tout ça fonctionne à merveille sur mon ordinateur parce que les chemins sont bien spécifiés.
Mais dès que je mets le fichier sur un autre ordinateur, je dois y mettre également la base de données, et mettre manuellement les liens à jours, ainsi que le code.
Y a-t-il un moyen plus simple pour mettre à jour automatiquement les liens hypertextes ?
Je vous remercie de vos réponses, et j'espère que ma question est claire !
Bonjour Guicart
Pour ce qui est des liens, il faut mettre le chemin UNC
Plutôt que de mettre une lettre de lecteur, il faut mettre le chemin complet via le serveur
D:\Commun
par
\\MonServeur\Commun
Sinon pour réparer des liens j'utilise ceci
Sub RéparationLiens()
Dim sPath As String
Dim DLig As Long, Cel As Range, sLien As String, sVal As String
Dim Lig As Long, Col As Long
' Récupérer le chemin d'accès du dossier souhaité
sPath = "\\Serveur1\Commun\Agence")
' Avec la feuille de suivi
With Sheets("MaFeuille")
DLig = .Range("A" & Rows.Count).End(xlUp).Row
For Each Cel In .Range("AG3:AQ" & DLig)
If Cel.Hyperlinks.Count > 0 Then
sLien = Cel.Hyperlinks.Item(1).Address
sVal = Cel.Value
' Reconstituer le lien
sLien = Replace(sLien, "/", "\")
sLien = Replace(sLien, "..\", "")
sLien = Replace(sLien, "%255b", "[")
sLien = Replace(sLien, "%255d", "]")
sLien = Replace(sLien, "%25255b", "[")
sLien = Replace(sLien, "%25255d", "]")
sLien = Replace(sLien, "%2525255b", "[")
sLien = Replace(sLien, "%2525255d", "]")
' supprimer le chemin d'accès réseau pour le remplacer correctement
sLien = Replace(sLien, "\\Serveur1\Commun\AGENCE\", "")
sLien = Replace(sLien, "Serveur1\Commun\AGENCE\", "")
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
If InStr(1, sLien, sPath) = 0 Then
sLien = sPath & sLien
End If
' Recréer le lien
Application.EnableEvents = False
Lig = Cel.Row: Col = Cel.Column
Cel.Hyperlinks.Delete
.Hyperlinks.Add Anchor:=.Cells(Lig, Col), Address:=sLien, TextToDisplay:=sVal
Application.EnableEvents = True
End If
Next Cel
End With
End Sub
A+
Merci beaucoup Bruno M45.
J'avoue ne pas être encore très doué avec VBA, et je ne connais pas du tout le chemin UNC.
Que représente MonServeur\Commun ? Et comment cela se passe quand je change d'ordinateur ?
Sinon la tactique de récupération des liens me parait bien pratique, mais elle ne me permettra malheureusement pas de modifier mon code pour que les nouvelles fiches aillent s'enregistrer au bon endroit.