Liens hypertexte dans une listebox

Version imprimable

2 pièce(s) jointe(s)

Bonjour,

Dans la continuité de mon projet de créer un "annuaire à citations", je me permets de créer un topic concernant une nouvelle problématique.

J'ai créé dans mon document un module de recherche dans lequel je peux taper un mot et qui va chercher si ce mot est présent dans une colonne définie (la colonne K).

Pièce jointe 593085

Les résultats sont affichés sur une listbox qui me donne l'ID correspondant pour aller la chercher. Cependant j'aimerai que lorsque je clique sur le résultat de la listebox, il m'emmène directement à la ligne du tableau concernée.

Quelqu'un aurait-il une idée ?

J'ai joins le fichier excel au besoin (voir Pièce jointe 593086) sinon le code est le suivant :

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
Private Sub TextBox1_Change()
 
    Application.ScreenUpdating = False
 
    Range("A7:A1000").Interior.ColorIndex = 0 'enlève la couleur lorsqu'on vide la recherche sur la colonne A
    Range("B7:B1000").Interior.ColorIndex = 0
    Range("C7:C1000").Interior.ColorIndex = 0
    Range("D7:D1000").Interior.ColorIndex = 0
    Range("E7:E1000").Interior.ColorIndex = 0
    Range("F7:F1000").Interior.ColorIndex = 0
    Range("G7:G1000").Interior.ColorIndex = 0
    Range("H7:H1000").Interior.ColorIndex = 0
    Range("I7:H1000").Interior.ColorIndex = 0
    Range("J7:H1000").Interior.ColorIndex = 0
    Range("K7:H1000").Interior.ColorIndex = 0
    ListBox1.Clear
 
    If TextBox1 <> "" Then 'Si la boite de recherche n'est pas vide
        For ligne = 7 To 100 'champs où la recherche est faites
            If Cells(ligne, 11) Like "*" & TextBox1 & "*" Then 'Si la cellule de la 1ère colonne correspond à la recherche
                Cells(ligne, 1).Interior.ColorIndex = 8 'surligne la 1ère colonne de la ligne en vert
                Cells(ligne, 2).Interior.ColorIndex = 8
                Cells(ligne, 3).Interior.ColorIndex = 8
                Cells(ligne, 4).Interior.ColorIndex = 8
                Cells(ligne, 5).Interior.ColorIndex = 8
                Cells(ligne, 6).Interior.ColorIndex = 8
                Cells(ligne, 7).Interior.ColorIndex = 8
                Cells(ligne, 8).Interior.ColorIndex = 8
                Cells(ligne, 9).Interior.ColorIndex = 8
                Cells(ligne, 10).Interior.ColorIndex = 8
                Cells(ligne, 11).Interior.ColorIndex = 8
                ListBox1.AddItem Cells(ligne, 1)
 
            End If
        Next
    End If
 
End Sub

Vous remerciant par avance de l'aide apportée ou du temps consacré.

1 pièce(s) jointe(s)

Bonjour,

Citation:

Envoyé par Zhankou

Cependant j'aimerai que lorsque je clique sur le résultat de la listebox, il m'emmène directement à la ligne du tableau concernée.

Voici ton code épuré avec le positionnement que tu voulais obtenir.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub ListBox1_Click()
    Rows(ListBox1.List(ListBox1.ListIndex, 2)).Activate
End Sub
 
Private Sub TextBox1_Change()
 
    Application.ScreenUpdating = False
 
    Range("A7:H1000").Interior.ColorIndex = 0 'enlève la couleur lorsqu'on vide la recherche sur la colonne A
    ListBox1.Clear
 
    If TextBox1 <> "" Then 'Si la boite de recherche n'est pas vide
        For ligne = 7 To 100 'champs où la recherche est faites
            If Cells(ligne, 11) Like "*" & TextBox1 & "*" Then 'Si la cellule de la 1ère colonne correspond à la recherche
                Cells(ligne, 1).Resize(1, 11).Interior.ColorIndex = 8 'surligne la 1ère colonne de la ligne en vert
                ListBox1.AddItem Cells(ligne, 1)
                ListBox1.List(ListBox1.ListCount - 1, 2) = ligne
            End If
        Next
    End If
 
End Sub

11/03/2021, 00h12
Zhankou

Merci infiniment c'est parfait !
Juste si ce n'est pas trop demandé, vous pensez qu'il serait possible que lorsque l'on reclique sur l'ID de la listbox, si on a bougé après avoir été déplacé à la ligne on retourne à nouveau dessus en recliquant dessus ?

Encore merci.
11/03/2021, 08h31
anasecu

Bonjour,

Bien sûr, lorsque tu cliques sur la liste, tu sélectionnes la ligne affichée et l'événement te positionne sur la ligne correspondante.

Bonjour,

Oui mais actuellement si je clique dessus et qu'ensuite je scroll vers le bas, il n'est pas possible de cliquer à nouveau sur l'ID. Si j'ai bien compris ton code, c'est parce que ton code sélectionne la ligne et c'est ce qui te déplace à l'endroit souhaité. Or si la ligne est déjà sélectionnée, il n'est pas possible de cliquer à nouveau dessus. Il faudrait donc je suppose créer dans la foulée un 'select' puis 'unselect' mais je n'ai pas trouvé la fonction associée.

Aussi, j'ai mis en place suite à ce que tu m'as transmis un bouton reset, qui reset tout les filtres de mon tableau et la recherche. Pour effacer la listbox et les lignes pas de problème par contre je ne trouve pas non plus la commande pour effacer le champs dans la textbox.

Le code est actuellement le suivant :
Code:

1 2 3 4 5 6 7 Private Sub CommandButton1 For i = 1 to 11 Cells(2,i)AutoFilter Field:=i, Criteria1:="*" Range ("A3:K1000").Interior.ColorIndex=0 ListBox1.Clear 'Textbox1.Clear -> ligne qui ne marche pas End Sub
pour la deuxième partie c'est bon, je viens de réaliser qu'il suffisait de faire Textbox1.text = "".

12/03/2021, 17h14
Zhankou

Petit up, je n'ai pas encore trouvé de solution concernant le fait de pouvoir cliquer à plusieurs reprises sur le tableau une fois la ligne sélectionnée et j'aimerai par ailleurs ajouté le fait que la recherche ne tienne pas compte des lignes masquées.

Si quelqu'un a une idée, ce serait génial.

Merci par avance.
12/03/2021, 18h24
anasecu

Bonjour,

Citation:

Envoyé par Zhankou

Oui mais actuellement si je clique dessus et qu'ensuite je scroll vers le bas, il n'est pas possible de cliquer à nouveau sur l'ID.

je ne comprend pas ce que tu dis car comme ta listbox est toujours visible le code ne s'occupe pas de tes déplacements et te repositionne bien sur la ligne de l'id cliqué même si elle n'est plus visible.

Si à côté, tu mets des filtres qui masquent l'id choisi même avec tous les reset de ta terre tu ne pourras pas l'afficher.
12/03/2021, 18h38
Zhankou

Bonjour Anasecu,

Excuse moi si je n'ai pas été clair. En fait il y a deux demandes distinctes (et je ne sais pas si elles sont réalisables) :

1. La listebox affiche l'ID et m'emmène dessus si je clique dessus. Toutefois si je reclique à nouveau dessus, rien ne se passe puisqu'elle est toujours sélectionnée. Il faut alors réinitialiser la recherche pour pouvoir à nouveau utiliser la fonction. Pour cela je me suis dit qu'il faudrait ajouter un unselect ou un desactivate juste après avoir cliqué dans l'id de la listbox.

2. J'aimerai trouver un moyen pour que la listbox n'affiche que les lignes visibles et non masquées pour éviter justement ce que tu soulignes à savoir essayer de cliquer sur un ID dans la listbox qui n'est pas visible. Cela devrait me permettre d'utiliser également les fonctions de filtre et segmentation par la suite.

Je te remercie en tout cas pour tes interventions.

Bonjour,

Citation:

Envoyé par Zhankou

En fait il y a deux demandes distinctes

Pourquoi distinctes ?

Citation:

je me suis dit qu'il faudrait ajouter un unselect

Pourquoi faire compliqué alors qu'il te suffit de changer d'id et revenir ?

Citation:

Cela devrait me permettre d'utiliser également les fonctions de filtre

C'est justement ceci que tu pourrais utiliser et tu n'as plus besoin de ta listbox. Essaies par exemple ce code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Private Sub TextBox1_Change() Dim lig As Long, col As Long, nbt As Integer With ActiveSheet.ListObjects("tableau4").DataBodyRange .Rows.Hidden = False For lig = 1 To .Rows.Count nbt = 0 For col = 1 To .Columns.Count If InStr(.Item(lig, col).Value, TextBox1) > 0 Then nbt = nbt + 1 Next col If nbt = 0 Then .Rows(lig).Hidden = True Next lig End With End Sub

13/03/2021, 12h35
Zhankou

Bonjour Anasecu,

C'est effectivement assez génial et ça me permet de me passer de la listbox.

Après le soucis que je peux voir c'est que si je filtre le tableau par exemple sur "romantisme" dans Mouvement, Victor Hugo et Nerval apparait.
Si j'ajoute par dessus la recherche Victor, tout marche plus qu'une ligne affichée. Par contre si j'efface la recherche Nerval ne réapparait pas.

Merci infiniment pour l'aide que tu m'apportes en tout cas.

Bonjour,

Citation:

Envoyé par Zhankou

Si j'ajoute par dessus la recherche Victor, tout marche plus qu'une ligne affichée

Je suppose que dans ta textbox tu veux saisir plusieurs mots séparés par un espace, alors je te propose comme ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub TextBox1_Change()
Dim lig As Long, col As Long, idx As Integer, elm
    elm = Split(TextBox1.Value & " ", " ")
    With ActiveSheet.ListObjects("tableau4").DataBodyRange
        .Rows.Hidden = False
        For lig = 1 To .Rows.Count
            ReDim nbt(LBound(elm) To UBound(elm))
            For col = 1 To .Columns.Count
                For idx = LBound(elm) To UBound(elm)
                    If elm(idx) <> "" Then
                        If InStr(.Item(lig, col).Value, elm(idx)) > 0 Then nbt(idx) = nbt(idx) + 1
                    End If
                Next idx
            Next col
            For idx = LBound(elm) To UBound(elm)
                If nbt(idx) = "" And elm(idx) <> "" Then .Rows(lig).Hidden = True
            Next idx
        Next lig
    End With
End Sub

Ainsi si tu saisis 'tis vi' ou 'tis ug' tu n'auras plus que la ligne Victor Hugo.
Comme tu as dû comprendre la recherche se fait sur l'ensemble du tableau et donc si tu saisis 'nei' tu auras Zola car il y a neige dans la citation.
Il ne te reste plus qu'à intégrer le code pour pouvoir le maitriser.

Bon week-end

14/03/2021, 17h26
Zhankou

Bonjour Anasecu,

Je viens de prendre connaissance de ton message. Le problème persistant et que si je filtre les colonnes avec une segmentation et que j'utilise la recherche par dessus, lorsque j'efface la recherche, rien ne se passe. Tu penses qu'il y a un moyen de régler ça ou l'outil de recherche ne pourra jamais fonctionner en parallèle des filtres ?

Bonne fin de week-end.

Bonjour,

Citation:

Envoyé par Zhankou

Tu penses qu'il y a un moyen de régler ça ou l'outil de recherche ne pourra jamais fonctionner en parallèle des filtres ?

Tu sais il n'y a pas beaucoup de problèmes impossibles à régler. Essaies avec ce code et tu devrais avoir ce que tu recherches.

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
Private Sub TextBox1_Change()
Dim lig As Long, col As Long, idx As Integer, flt As Boolean, elm
    With ActiveWorkbook.ActiveSheet
        elm = Split(TextBox1.Value & " ", " ")
        With .ListObjects("tableau4")
            flt = .ShowAutoFilterDropDown
            If flt Then .ShowAutoFilterDropDown = False
            With .DataBodyRange
                .Rows.Hidden = False
                For lig = 1 To .Rows.Count
                    ReDim nbt(LBound(elm) To UBound(elm))
                    For col = 1 To .Columns.Count
                        For idx = LBound(elm) To UBound(elm)
                            If elm(idx) <> "" Then
                                If InStr(.Item(lig, col).Value, elm(idx)) > 0 Then nbt(idx) = nbt(idx) + 1
                            End If
                        Next idx
                    Next col
                    For idx = LBound(elm) To UBound(elm)
                        If nbt(idx) = "" And elm(idx) <> "" Then .Rows(lig).Hidden = True
                    Next idx
                Next lig
            End With
            If flt Then .ShowAutoFilterDropDown = True
        End With
    End With
End Sub

23/03/2021, 20h53
Zhankou

1 pièce(s) jointe(s)

Merci beaucoup Anasecu pour l'aide apporté sur mon projet et désolé de ne pas l'avoir fait plus tôt, semaine de cours chargée avec les révisions pour le BAC.

Pour ce qui est du code proposé, j'ai pu l'essayé et il marche mais je n'ai pas encore eu le temps de le comprendre. Je vais m'atteler dessus ce week-end, c'est quand même impressionnant ce qu'il est possible de faire avec Excel.

Finalement il va falloir que je laisse la listbox qui m'apparait nécessaire pour connaitre le nombre de résultats trouvé par la recherche.

Aussi il me reste donc à mettre en place les éléments suivants :

1. Que les lignes masquées n'apparaissent pas dans la listbox (idéalement il faudrait que j'arrive à combiner avec le code de Anasecu qui efface les lignes non pertinente mais il va falloir que j'arrive à comprendre son code avant pour que les deux marchent ensemble).
2. Que le choix effectué dans les combobox soient gardés en souvenir jusqu'à la fermeture du document si je reclique sur le bouton Filtre
3. Que le choix effectué dans les combobox influe l'un sur l'autre (exemple si j'ai Romantisme dans la combobox Mouvement, dans la combobox Figure il faudrait qu'apparaisse uniquement Parataxe et Oxymore car il n'y a pas d'autres figure avec Romantisme).

Je remet le document à jour au besoin.

Encore merci à ce forum et à ceux qui y participent.