Personnellement je ne la connaissais pas .......... mais je l'ai cherchéCela serait étonnant que l'on puisse pas le faire
SI quelqu'un connait la solution ?
les liens hypertexte sont pourtant bien présents ( en colonne B)Je ne vois pas de liens hypertexte dans ton exemple ?
............ avec ma boule de cristal qui est en panne et sans voir ce fichier,...................J’ai donc décidé d’en faire un
Mais cela s’avère impossible, car on a plus accès au clic droit !
J’en ai donc fait un avant de valider ta macro.
Mais quand je valide ta macro, en suivant ta démarche
Le lien que j’ai créé ne se recopie pas ....
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target = "" Or Sheets(3).Range("A1") = "" Then Exit Sub
Target.Hyperlinks.Add Anchor:=Selection, Address:="" & Sheets(3).Range("A1") & ""
Sheets(3).Range("A1") = ""
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Cancel = True
On Error Resume Next
Sheets(3).Range("A1") = Target.Hyperlinks(1).Address
End Sub
Bonjour
Pour des liens hypertexte vers une adresse Web ou des fichiers extérieurs
Cette nouvelle macro fonctionne parfaitement
Mais comme dans les 2 cas on perd l’usage du clic droit sur les cellules pleines,
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
On Error Resume Next
If Target.Hyperlinks(1).Address = "" Then Exit Sub
Cancel = True
Sheets(3).Range("A1") = Target.Hyperlinks(1).Address
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
dim a$, sa$
If Target.Count = 1 Then
If Target.Hyperlinks.Count = 1 Then
a = Target.Hyperlinks(1).Address
sa = Target.Hyperlinks(1).SubAddress
Application.EnableEvents = False
Application.Undo
Me.Hyperlinks.Add Target, a, sa
Application.EnableEvents = True
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a$, sa$, d$
If Target.Count = 1 Then
If Target.Hyperlinks.Count = 1 Then
a = Target.Hyperlinks(1).Address
sa = Target.Hyperlinks(1).SubAddress
d = Target
Application.EnableEvents = False
Application.Undo
Me.Hyperlinks.Add Target, a, sa, TextToDisplay:=d
Application.EnableEvents = True
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a$, sa$
If Target.Count = 1 Then
If Target.Hyperlinks.Count = 1 Then
a = Target.Hyperlinks(1).Address
sa = Target.Hyperlinks(1).SubAddress
Application.EnableEvents = False
Application.Undo
If a = "" Then Me.Hyperlinks.Add Target, a, sa _
Else Me.Hyperlinks.Add Target, a
Application.EnableEvents = True
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a$, sa$, d$
If Target.Count = 1 Then
If Target.Hyperlinks.Count = 1 Then
a = Target.Hyperlinks(1).Address
sa = Target.Hyperlinks(1).SubAddress
d = Target
Application.EnableEvents = False
Application.Undo
If a = "" Then Me.Hyperlinks.Add Target, a, sa, TextToDisplay:=d _
Else Me.Hyperlinks.Add Target, a, TextToDisplay:=d
Application.EnableEvents = True
End If
End If
End Sub