Bonjour à tous,
Je cherche a faire une boucle par rapport à une zone que j'aurais préalablement sélectionnée à la souris, qu'a chaque cellule soit mis l'hyperlien jusqu'a la fin de la sélection.
au coup par coup, mon code fonctionne (à peu près) par contre je peine avec la sélection "MaZone" à la souris...
La macro consiste à mettre en hyperlien le contenu de la cellule (nom et chemin de fichiers)
Je vous remercie d'avance pour votre support, et vous souhaite une belle journée.
------------------------------------
Sub Clipboard_Hyperlien()
Dim maZone As Range
Set Clipboard = New MSForms.DataObject
Clipboard.GetFromClipboard
strContents = Clipboard.GetText
With ActiveSheet
For Each maZone In Selection
If ActiveCell.Value <> "" Then
Application.ActiveWindow.ActiveCell.Copy
If strContents <> "" Then
strContents = Replace(strContents, Chr(34), "")
If Selection.Hyperlinks.Count > 0 Then Selection.Hyperlinks.Delete
ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:=strContents
With Selection
.HorizontalAlignment = xlLeft
.Font.Size = 12
.Font.TintAndShade = 0
.Font.Underline = xlUnderlineStyleSingle
' .Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
End With
Else
MsgBox "Aucun fichier dans le clipboard", vbInformation + vbOKCancel, "Opération annulée."
End If
Else
End If
Next
End Sub
Je cherche a faire une boucle par rapport à une zone que j'aurais préalablement sélectionnée à la souris, qu'a chaque cellule soit mis l'hyperlien jusqu'a la fin de la sélection.
au coup par coup, mon code fonctionne (à peu près) par contre je peine avec la sélection "MaZone" à la souris...
La macro consiste à mettre en hyperlien le contenu de la cellule (nom et chemin de fichiers)
Je vous remercie d'avance pour votre support, et vous souhaite une belle journée.
------------------------------------
Sub Clipboard_Hyperlien()
Dim maZone As Range
Set Clipboard = New MSForms.DataObject
Clipboard.GetFromClipboard
strContents = Clipboard.GetText
With ActiveSheet
For Each maZone In Selection
If ActiveCell.Value <> "" Then
Application.ActiveWindow.ActiveCell.Copy
If strContents <> "" Then
strContents = Replace(strContents, Chr(34), "")
If Selection.Hyperlinks.Count > 0 Then Selection.Hyperlinks.Delete
ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:=strContents
With Selection
.HorizontalAlignment = xlLeft
.Font.Size = 12
.Font.TintAndShade = 0
.Font.Underline = xlUnderlineStyleSingle
' .Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
End With
Else
MsgBox "Aucun fichier dans le clipboard", vbInformation + vbOKCancel, "Opération annulée."
End If
Else
End If
Next
End Sub