Hyperlinks en vba

[Alex]

Bonjour à tous

Je cherche depuis un moment mais sans résultat :S

Au fait j'aimerais savoir s'il est possible de récupérer en VBA (dans un label par exemple) le lien hypertexte contenu dans une cellule Excel.

Merci pour votre aide
A+

 

[_Thierry]

Bonjour Alex, le Forum

Pas tout à fait sûr d'avoir bien interprété ta question....

Dans un UserForm contenant un Label (Label1) et ayant dans la cellule Active un HyperLink à reporter :

Option Explicit

Private Sub UserForm_Initialize()
Dim H As Hyperlink
   
    For Each H In Worksheets(1).Hyperlinks
        If H.Range.Address = ActiveCell.Address Then
            With Me.Label1
            .Caption = H.Parent
            .Tag = H.Address
            End With
        End If
    Next

End Sub
Private Sub Label1_Click()
    ThisWorkbook.FollowHyperlink Me.Label1.Tag
End Sub

Bon Aprèm
@+Thierry

 

[Alex]

Merci Thierry je vais essayer
A+

 

[Alex]

Bonjour Thierry le forum

Effectivement ça marche très bien, mais c’est possible de donner dans le code simplement la range qui contient le lien hypertexte et l'afficher dans le label (sans que la cellule soit sélectionnée dans Excel) ?

A+

 

[_Thierry]

Bonjour Alex, le Forum

En restant sur exactement les mêmes bases, pour une cellule spécifiée, on peut faire ainsi

Private Sub UserForm_Initialize()
Dim Cell As Range
Dim H As Hyperlink
   
Set Cell = Sheets('Sheet1').Range('A1')
   
    For Each H In Worksheets(1).Hyperlinks
        If H.Range.Address = Cell.Address Then
            With Me.Label1
            .Caption = H.Parent
            .Tag = H.Address
            End With
        End If
    Next

End Sub
Private Sub Label1_Click()
    ThisWorkbook.FollowHyperlink Me.Label1.Tag
End Sub

Maintenant si tu as un cas de figure comme ceci

[li]10 Labels (Nommés Label1, Label2, etc)[/li]
[li]10 Hyperlinks Différents sur la Range A1:A10[/li]

On peut envisager de boucler ainsi :

Private Sub UserForm_Initialize()
Dim Cell As Range
Dim H As Hyperlink
Dim i As Byte
   
    With Sheets('Sheet1')
        For Each H In .Hyperlinks
            For Each Cell In .Range('A1:A10')
                If H.Range.Address = Cell.Address Then
                i = i + 1
                    With Me.Controls('Label' & i)
                        .Caption = H.Parent
                        .Tag = H.Address
                    End With
                End If
            Next Cell
        Next H
    End With
End Sub

Bon Appétit
[ol]@+Thierry[/ol]

 

[Alex]

Merci beaucoup Thierry ça marche
effectivement c'est ce que je cherchais