Double clic dans listbox --> ouverture hypertexte lié

**Aurélien13140** · 26/05/2017, 04h42

Bonjour à tous,

Je viens vers vous car je suis confronté à un problème que je n'arrive pas à résoudre avec mes faibles connaissances en VBA.

J'ai un tableau sur une feuille "parametres" dans lequel j'ai une liste de lien hypertext (en colonne AP)
J'ai un userform (accessible depuis le bouton JTZ sur la feuille "TdB" puis sur le bouton "consultation") qui me permet d'afficher dans un listbox un certain nombre de lien hytertext en fonction des filtres que j'aurais choisis.

Jusque là, tout fonctionne.

Seulement voilà, j'aimerais que lorsque je double clique sur un des liens de la listbox, le lien hypertext s'ouvre directement.

Pouvez vous m'aider?

Ci jiont, la partie de mon fichier concerné

Merci beauuucouuupppp

**parmi** · 26/05/2017, 17h20

Bonjour,

Le lien dans ta listbox ne devrait pas être actif comme tel.
Il te faudrait retracer le lien dans ta feuille et utiliser un .Follow de ce lien pour l'activer.

PS: je n'ouvre pas les fichiers joints ave macros... désolé...

**Aurélien13140** · 28/05/2017, 20h04

Bonjour,
Merci de t’intéresser à mon problème.
J'ai fais des recherche sur le net concernant le .follow mais pour dire vrai, je m'y perd un peu...

Je peux comprendre que tu ne veuille pas ouvrir un fichier avec une macro donc pour faciliter tout ca, je te met en pj le fichier sans macro.
Voici à quoi ressemble mon UF
Nom : Sans titre.png
Affichages : 610
Taille : 12,9 Ko

Nom : Sans titre.png
Affichages : 610
Taille : 12,9 Ko

et voici le code dont je te parlais

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
Private Sub UserForm_activate()
 
Dim Auditeur, Audite, ValHab As Long
Call CommandButton3_Click
    Me.ComboBox3.List = Application.Transpose(Sheets("parametres").Range("AG6:AO6"))
End Sub
 
Private Sub CommandButton2_Click() 'Bouton Quitter
    Unload Me
End Sub
 
Private Sub CommandButton3_Click() 'Bouton Réinitialisation
    Me.Height = 285
    If CheckBox1.Value = True Then
        ListBox1.RowSource = ""
    Else
        ListBox1.Clear
    End If
    For i = 1 To 3
        Me.Controls("ComboBox" & i).Enabled = True
        Me.Controls("combobox" & i).Value = ""
    Next
    CheckBox1.Value = False
    ListBox1.Visible = False
End Sub
 
Private Sub CommandButton1_Click() 'Bouton Rechercher
 
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Me.Height = 400
'-------------------------------------------------------------
    'Filtre par "Afficher tous les JTZ"
        If CheckBox1.Value = True Then
            Dim Plage As String
                With Sheets("parametres")
                    Plage = .Range("AP8:AP" & .Range("AP50").End(xlUp).Row).Address
                End With
            ListBox1.RowSource = "parametres!" & Plage
        End If
'-------------------------------------------------------------
   'Filtre par "Auditeur"
    For i = 1 To 2
        If ComboBox1.Value = Sheets("parametres").Cells(i + 2, 3).Value Then
            Auditeur = i
        End If
    Next
    For x = 1 To 60
        If Sheets("parametres").Cells(7 + x, 25 + Auditeur) = "X" Then
            With ListBox1
                .AddItem Sheets("parametres").Cells(7 + x, 42)
            End With
        End If
    Next x
'-------------------------------------------------------------
   'Filtre par "Audité"
    For i = 1 To 5
        If ComboBox2.Value = Sheets("parametres").Cells(i + 3, 3).Value Then
            Audite = i
        End If
    Next
    For x = 1 To 60
        If Sheets("parametres").Cells(7 + x, 27 + Audite) = "X" Then
            With ListBox1
                .AddItem Sheets("parametres").Cells(7 + x, 42)
            End With
        End If
    Next x
'-------------------------------------------------------------
   'Filtre par "Validation d'habilitation"
    For i = 1 To 9
        If ComboBox3.Value = Sheets("parametres").Cells(6, 32 + i).Value Then
            ValHab = i
        End If
    Next
    For x = 1 To 60
        If Sheets("parametres").Cells(7 + x, 32 + ValHab) = "X" Then
            With ListBox1
                .AddItem Sheets("parametres").Cells(7 + x, 42)
            End With
        End If
    Next x
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
    ListBox1.Visible = True
End Sub
Private Sub listbox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'    Lien = ""
'    With ListBox1
''        shname = .List(.ListIndex, 0)
'        Set cel = Sheets("parametres").Range(.List(.ListIndex, 1))
'        If cel.Hyperlinks.Count > 0 Then Lien = cel.Hyperlinks(1).Address
'    End With
'    If Lien <> "" Then
'        Set ie = CreateObject("internetexplorer.application")
'        ie.Visible = True
'        ie.Navigate Lien
'        Set ie = Nothing
'    End If
End Sub

Peux tu m'indiquer comment utiliser le .follow? Ou bien une autre méthode peut être plus adaptée?
Merci

**parmi** · 28/05/2017, 23h56

Ça pourrait ressembler à ceci.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub listbox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim HLien As String
    Dim Recherche As Range
 
    HLien = Me.ListBox1.Text
    Set Recherche = Sheets("parametres").Columns("AP").Find(HLien, LookIn:=xlValues, LookAt:=xlWhole)
    If Not Recherche Is Nothing Then
        Sheets("parametre").Range("AP" & Recherche.Row).Hyperlink.Follow
    End If
 
'Call CommandButton2_Click
    Set Recherche = Nothing
End Sub

**Aurélien13140** · 29/05/2017, 07h48

Bonjour Parmi!

Quand je lis ton code, du moins de ce que j'arrive à comprendre, ca me semble être parfaitement la réponse à mon problème.
Pourtant, lorsque je le lance j'ai cette erreur qui tape :

Nom : Sans titre.png
Affichages : 508
Taille : 3,8 Ko

Nom : Sans titre.png
Affichages : 508
Taille : 3,8 Ko

ainsi que cette ligne qui est surlignée avec le débogeur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

        Sheets("parametres").Range("AP" & Recherche.Row).Hyperlink.Follow

J'ai eu un doute sur les cellules de la colonnes "AP" mais celles ci sont bien des liens hypertexts.

Aurais tu une piste?

**Aurélien13140** · 29/05/2017, 11h02

Alors après avoir recherché sur le net, j'ai réussi à faire fonctionner ton code en remplaçant ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("parametres").Range("AP" & Recherche.Row).Hyperlink.Follow

Par ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Recherche.Hyperlinks(1).Follow

Ce qui donne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub listbox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 
    Dim HLien As String
    Dim Recherche As Range
 
    HLien = Me.ListBox1.Text
    Set Recherche = Sheets("parametres").Columns("AP").Find(HLien, LookIn:=xlValues, LookAt:=xlWhole)
    If Not Recherche Is Nothing Then
'       Sheets("parametres").Range("AP" & Recherche.Row).Hyperlink.Follow
    Recherche.Hyperlinks(1).Follow ' NewWindow:=False, AddHistory:=True
    End If
    Set Recherche = Nothing
 
End Sub

Peux tu m'expliquer la différence?

Pourrais tu également m'expliquer cette partie dans la ligne 7 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Find(HLien, LookIn:=xlValues, LookAt:=xlWhole)

Même si je ne suis qu'un débutant, j'aime comprendre ce que je fais sans recopier de façon bête et discipliné

Merci

Double clic dans listbox --> ouverture hypertexte lié [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager