Listbox avec recherche

Version imprimable

Bonjour,

Ci-dessous le code de Boisgonthier transmis il y a plusieurs année et je vous en remercie.

J'essaie d'afficher un bouton situé sur le USF lorsque le résultat de la recherche ne donne rien via le TextBox1_Change.
Pourriez-vous me donner un coup de main ?

Une autre demande, pourriez-vous déclarer les variables du code ci-dessous ?

Merci pour votre aide et meilleures salutations
Philippe

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
Option Explicit
Dim F, choix()
Private Sub BT_Ajouter_Contact_Click()
        If MsgBox("Inserer un nouveau Contact ?", vbYesNo + vbQuestion, "Contact") = vbYes Then
        Unload Me
            MsgBox "OUI"
            Else
            MsgBox "NON"
     End If
End Sub
Private Sub ListBox1_Click()
Dim Resultat As Variant
    Resultat = Me.ListBox1
        MsgBox Resultat
   Unload Me
End Sub
Private Sub UserForm_Initialize()
        Set F = Sheets("DATA Contacts Internes")
        Set Rng = F.Range("B3:B" & F.[B65000].End(xlUp).Row) ' Sélectionne toutes les lignes non vide, pas de ligne vide à la fin du formulaire
        choix = Application.Transpose(Rng)
        Me.ListBox1.List = choix
        Me.TextBox1.SetFocus 'Place le curseur dans la textbox
End Sub
Private Sub TextBox1_Change()
        Mots = Split(Trim(Me.TextBox1), " ") ' Permet une recherche multiple, taper les requêtes en séparant par un espace
        Tbl = choix
    For I = LBound(Mots) To UBound(Mots)
        Tbl = Filter(Tbl, Mots(I), True, vbTextCompare)
    Next I
        Me.ListBox1.List = Tbl
'Masquer ou afficher le bouton Ajouter un contact si la recherche est nul
        If ListBox1 = "" Then
        BT_Ajouter_Contact.Visible = True
    Else
        BT_Ajouter_Contact.Visible = False
    End If
End Sub
Private Sub CommandButton1_Click()
    Unload Me
End Sub

17/08/2019, 08h14
Pierre Fauconnier
Salut.

Voici un exemple qui utilise une variable booléenne déterminant si la recherche a été fructueuse ou pas. Si Found = False, le bouton devient visible, sinon il devient invisible.
Code:

1 2 3 4 5 6 Private Sub TextBox1_Change() Dim Found As Boolean ... ' Le code de recherche qui va valoriser Found... ou pas ;) CommandButton1.Visible = (Found = False) End Sub
Citation:

Envoyé par goninph

[...]
Une autre demande, pourriez-vous déclarer les variables du code ci-dessous ?[...]

Je n'ai pas compris ta demande :koi:

1 pièce(s) jointe(s)

Bonjour,

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
Private Sub UserForm_Initialize()
  Set f = Sheets("DATA Contacts Internes")
  Set Rng = f.Range("B3:B" & f.[B65000].End(xlUp).Row) ' Sélectionne toutes les lignes non vide, pas de ligne vide à la fin du formulaire
  choix = Application.Transpose(Rng)
  Me.ListBox1.List = choix
  Me.TextBox1.SetFocus 'Place le curseur dans la textbox
End Sub
 
Private Sub ListBox1_Click()
  Dim Resultat As Variant
  Resultat = Me.ListBox1
  MsgBox Resultat
  Unload Me
End Sub
 
Private Sub TextBox1_Change()
  Dim Mots, Tbl, i, temp
  Mots = Split(Trim(Me.TextBox1), " ") ' Permet une recherche multiple, taper les requêtes en séparant par un espace
  Tbl = choix
  For i = LBound(Mots) To UBound(Mots)
    Tbl = Filter(Tbl, Mots(i), True, vbTextCompare)
  Next i
  Me.ListBox1.List = Tbl
  'Masquer ou afficher le bouton Ajouter un contact si la recherche est nul
  BT_Ajouter_Contact.Visible = (ListBox1.ListCount = 0)
End Sub
 
Private Sub BT_Ajouter_Contact_Click()
  If MsgBox("Inserer un nouveau Contact ?", vbYesNo + vbQuestion, "Contact") = vbYes Then
     Unload Me
     MsgBox "OUI"
  Else
     MsgBox "NON"
  End If
End Sub

Boisgontier

17/08/2019, 17h24
goninph

Merci boisgontierjacques,

BT_Ajouter_Contact.Visible = (ListBox1.ListCount = 0) c'est parfait

Ne pas oublier de mettre visible à False dans les propriété du bouton

Encore mille merci
Meilleures salutations
Philippe
19/08/2019, 14h49
goninph

Bonjour,

Cette recherche dans une listbox est fantastique, encore merci à boisgontierjacques pour le travail effectué.

Serait'il possible d'ignorer les accents lors de la recherche, par exemple si on tape "ete" , les mots "été" ou "éternel" ... devraient être trouvés.

Est ce possible ?

Merci et meilleures salutations
Philippe

1 pièce(s) jointe(s)

Bonsoir,

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
Option Explicit
Dim f, choix(), choixSA(), Rng
Private Sub UserForm_Initialize()
  Dim i
  Set f = Sheets("DATA Contacts Internes")
  Set Rng = f.Range("B3:B" & f.[B65000].End(xlUp).Row) ' Sélectionne toutes les lignes non vide, pas de ligne vide à la fin du formulaire
  choix = Application.Transpose(Rng)
  choixSA = Application.Transpose(Rng)
  For i = 1 To UBound(choixSA)
   choixSA(i) = sansAccent(choixSA(i))
  Next i
  Me.ListBox1.List = choix
  Me.TextBox1.SetFocus 'Place le curseur dans la textbox
End Sub
 
Private Sub ListBox1_Click()
  Dim Resultat As Variant
  Resultat = Me.ListBox1
  MsgBox Resultat
  Unload Me
End Sub
 
Private Sub TextBox1_Change()
  Dim Mots, Tbl, i, temp
  Mots = Split(sansAccent(Trim(Me.TextBox1)), " ") ' Permet une recherche multiple, taper les requêtes en séparant par un espace
  Tbl = choixSA
  For i = LBound(Mots) To UBound(Mots)
    Tbl = Filter(Tbl, Mots(i), True, vbTextCompare)
  Next i
  Me.ListBox1.List = Tbl
  'Masquer ou afficher le bouton Ajouter un contact si la recherche est nul
  If ListBox1.ListCount = 0 Then
     BT_Ajouter_Contact.Visible = True
  Else
     BT_Ajouter_Contact.Visible = False
  End If
End Sub
 
Private Sub BT_Ajouter_Contact_Click()
  If MsgBox("Inserer un nouveau Contact ?", vbYesNo + vbQuestion, "Contact") = vbYes Then
     Unload Me
     MsgBox "OUI"
  Else
     MsgBox "NON"
  End If
End Sub
 
Private Sub CommandButton1_Click()
    Unload Me
End Sub
 
Function sansAccent(chaine)
   Dim codeA, codeB, i, temp, p
   codeA = "ÉÈÊËÔéèêëàçùôûïî"
   codeB = "EEEEOeeeeacuouii"
   temp = chaine
   For i = 1 To Len(temp)
    p = InStr(codeA, Mid(temp, i, 1))
    If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
   Next
   sansAccent = temp
End Function

Boisgontier

20/08/2019, 18h57
goninph

Excellent topissime merci boisgontierjacques

Meilleures salutations
Philippe