question sur les liens hypertexte

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