Ouverture des liens hypertext par un doucle-clic au lieu du simple clic

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
ThisWorkbook.FollowHyperlink Target
If Err = 0 Then Cancel = True
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If InStr(Target, "/") + InStr(Target, "\") Then
  Cancel = True
   ThisWorkbook.FollowHyperlink Target
ElseIf Left(Target, 1) = "#" Then
  Cancel = True
  Application.Goto Evaluate(Mid(Target, 2))
End If
End Sub

Sub TransfertLien()
Dim chemin$, h As Hyperlink
chemin = ThisWorkbook.Path & "\" 'pas forcément nécessaire
For Each h In [A:A].Hyperlinks 'si liens en colonne A
  h.Parent(1, 2) = chemin & h.Address
  h.Delete
Next
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If InStr(Target(1, 2), "\") Then
  Cancel = True
  ThisWorkbook.FollowHyperlink Target(1, 2)
End If
End Sub

Sub TransfertLien()
'Alt+F8 pour exécuter la macro
Transfert [B1:B25], 36 'à adapter
'autres colonnes de liens
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
DoubleClic [B1:B25], 36, Target, Cancel 'à adapter
'autres colonnes de liens
End Sub

Sub Transfert(Source As Range, col_dest%)
Dim h As Hyperlink
Application.ScreenUpdating = False
With Source
  .Copy
  .Columns(col_dest).PasteSpecial xlPasteFormats 'stockage des formats
  For Each h In .Hyperlinks
    h.Parent(1, col_dest) = h.Address
    h.Delete
  Next
  .Columns(col_dest).Copy
  .PasteSpecial xlPasteFormats 'restitution des formats
  .Cells(1).Select
End With
Application.CutCopyMode = False
End Sub

Sub DoubleClic(Source As Range, col_dest%, Target As Range, Cancel As Boolean)
If Intersect(Target, Source) Is Nothing Or Target(1, col_dest) = "" Then Exit Sub
Cancel = True
ThisWorkbook.FollowHyperlink Target(1, col_dest)
End Sub

Sub TransfertLien()
Transfert [B1:B25], 36 'à adapter
'autres colonnes
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
DoubleClic [B1:B25], 36, Target, Cancel 'à adapter
'autres colonnes
End Sub

Sub Transfert(Source As Range, col_dest#)
Dim t$(), i&
Application.ScreenUpdating = False
With Source
  .Copy
  .Columns(col_dest).PasteSpecial xlPasteFormats 'stockage des formats
  ReDim t(1 To Source.Count, 1 To 1) 'matrice, plus rapide
  For i = 1 To UBound(t)
    If Source(i).Hyperlinks.Count Then
      t(i, 1) = Source(i).Hyperlinks(1).Address
      Source(i).Hyperlinks(1).Delete
    End If
  Next
  .Columns(col_dest) = t
  .Columns(col_dest).Copy
  .PasteSpecial xlPasteFormats 'restitution des formats
  .Cells(1).Select
End With
Application.CutCopyMode = False
End Sub

Sub DoubleClic(Source As Range, col_dest#, Target As Range, Cancel As Boolean)
If Intersect(Source, Target) Is Nothing Or Target(1, col_dest) = "" Then Exit Sub
Cancel = True
ThisWorkbook.FollowHyperlink Target(1, col_dest)
End Sub