Double clic dans listbox --> ouverture hypertexte lié

Version imprimable

26/05/2017, 04h42
Aurélien13140

1 pièce(s) jointe(s)

Double clic dans listbox --> ouverture hypertexte lié

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
26/05/2017, 17h20
parmi

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é...

2 pièce(s) jointe(s)

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
Pièce jointe 280178

et voici le code dont je te parlais

Code:

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

Ça pourrait ressembler à ceci.

Code:

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

29/05/2017, 07h48
Aurélien13140

1 pièce(s) jointe(s)

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 :

Pièce jointe 280307

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

Code:

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?

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

Code:

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

Par ça

Code:

Recherche.Hyperlinks(1).Follow

Ce qui donne
Code:

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:

.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é :fou:

Merci

29/05/2017, 11h29
parmi

Find est l'équivalent de Ctrl-F (recherche Excel)
xlValues recherche le texte trouvé dans la listbox dans le texte d'une cellule et non pas dans sa formule
xlWhole force à rechercher dans le contenu complet de la cellule plutôt qu'une partie de celle-ci
29/05/2017, 14h23
Aurélien13140

Merci

Voilà qui répond à ma question et résout mon problème

Résolu!!