Private Sub Workbook_Open()
Dim VDir As String, HLink As String, FlgFic As Boolean, Sht As Worksheet
Dim DerLig As Long, StBar As Boolean
' Définit le classeur ou se trouve les liens
Set Sht = Sheets("Feuil1")
' Récupère la dernière ligne utilisée
DerLig = Sht.Range("D1").SpecialCells(xlCellTypeLastCell).Row
' Affichage d'un message dans la barre d'état
StBar = Application.DisplayStatusBar
If StBar = False Then Application.DisplayStatusBar = True
Application.StatusBar = "Veuillez patienter création/suppression des liens Hypertext ..."
' Empècher les erreurs de s'afficher
On Error Resume Next
' Effectue une boucle de la ligne 2 à DerLig
For lig = 2 To DerLig
' Effectue une boucle pour chaque colonne
For Col = 1 To 4
' Récupère le chemin du dossier
VDir = Sht.Cells(lig, 3 + Col).Value
' On continue la boucle si aucun nom de dossier dans la cellule
' Empèche le message d'erreur 52
If VDir = "" Then GoTo SuiteCol
' Vérifie l'antislash de fin
If Right(VDir, 1) <> "\" Then VDir = VDir & "\"
' Met le lien hypertext si le dossier contient au moins un fichier
If Dir(VDir & "\") <> "" Then
Target.Hyperlinks.Add Anchor:=Selection, Address:=VDir, TextToDisplay:=VDir
Else
Target.Hyperlinks.Delete
End If
SuiteCol:
Next Col
Next lig
Set Sht = Nothing
Application.StatusBar = ""
Application.DisplayStatusBar = StBar
On Error GoTo 0
End Sub
