XL 2016 Bonsoir, je suis à la recherche d'un code qui me permettrait d'ouvrir un chemin reseau et de me renvoyer le lien hypertext sur le texte de la cellule.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim MonDossier As String, MonFichier As String
  Cancel = True ' Evite d'entrée en mode esition dans la cellule
  If Not Application.Intersect(Target, Range("C18:C57")) Is Nothing Then
    MonDossier = "L:\1. Sécurité & Environnement\Accidents & analyse 5 pourquoi et arbres des causes\2020" '<-- adaptez le nom du Dossier
    ' Vérifier l'anti-skash de fin
    If Right(MonDossier, 1) <> "\" Then MonDossier = MonDossier & "\"
    ' Vérifier l'existence du dossier, quoi que pas forcément nécessaire
    If Len(Dir(MonDossier, vbDirectory)) > 0 Then
      MonFichier = ChoixFichier(MonDossier, "CHOIX du FICHIER", "*.*,*.*")
      ' Si MonFichier n'est pas vide
      If MonFichier <> "" Then
        ' S'il s'agit d'un lecteur réseau, inutile de mettre "file://"
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=MonFichier, TextToDisplay:=Selection.Value
      End If
    End If
  End If
End Sub

Function ChoixFichier(DefaultPath As String, sTitre As String, Optional sFilter As String)
  ' LE filtre doit être du type : "BdD Communes (*.xlsx), *.xlsx"
  Dim fd As FileDialog, TabFilter() As String
  ' Initialiser les variables
  If Right(DefaultPath, 1) <> "\" Then DefaultPath = DefaultPath & "\"
  ' Initialiser l'intance du dialogue
  Set fd = Application.FileDialog(msoFileDialogFilePicker)
  With fd
    .Filters.Clear
    ' Si un filtre a été donné
    If sFilter <> "" Then
      TabFilter = Split(sFilter, ",")
      .Filters.Add TabFilter(0), Trim(TabFilter(1))
    End If
    .Title = sTitre
    .InitialFileName = DefaultPath & TabFilter(0)
    If .Show = -1 Then
      ChoixFichier = fd.SelectedItems(1)
    End If
  End With
  Set fd = Nothing
End Function