Discussion :

[grisan29]

bonjour a vous

sur un usf il y a une listbox qui recoit ses infos d'une combobox1 jusque la pas de problème le code de la combobox1 qui fait appel a essai est dans le module1
mais lorsque je veux affinée la recherche par nom a l'aide de la combobox2 la recherche fait abstention de la première colonne dans la listbox peut etre est-ce du au module1 "cherche" et le problème est identique en faisant la recherche par lettre dans un textbox qui fait appel au meme module
code l'usf

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
Option Explicit
Private Sub cmdExit_Click()
Unload Me
End Sub
 
Private Sub ComboBox1_Change()
 
    If Me.ComboBox1 <> "" Then
        Me.ListBox1.Clear
        Set Ws = Sheets(Me.ComboBox1.Text)
        Call essai 'module1
        IniCbo2    'module1
    End If
    ComboBox1.ListIndex = 0
 
End Sub
 
Private Sub ComboBox2_Change()
    If Me.ComboBox2 <> "" Then
        With Me.ListBox1
            .ColumnCount = 9
            .ColumnWidths = "60;80;250;60;40;40;40;40;40;40"
            .Clear
        End With
        Cherche Me.ComboBox2.Text
    End If
 
End Sub
 
 
Private Sub ListBox1_Click()
  With ListBox1
    TextBox2 = .List(.ListIndex, 0)
    TextBox3 = .List(.ListIndex, 2)
    TextBox4 = .List(.ListIndex, 5)
    TextBox5 = .List(.ListIndex, 8)
    TextBox6 = .List(.ListIndex, 6)
 
  End With
 
End Sub
 
Private Sub TextBox1_Change()
 
    If Me.ComboBox1 <> "" Then
        If TextBox1 <> "" Then
        With Me.ListBox1
            .ColumnCount = 9
            .ColumnWidths = "60;80;250;60;40;40;40;40;40;40"
            .Clear
        End With
            Cherche TextBox1.Text
        End If
    Else
        MsgBox "Sélection d'une feuille,svp"
        Me.ComboBox1.SetFocus
    End If
 
End Sub
 
Private Sub UserForm_Initialize()
    Me.ListBox1.Clear
    Dim Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name = "plomberie" Or Sh.Name = "électricité" Or Sh.Name = "carrelage" Or Sh.Name = "SDB" Or Sh.Name _
        = "Plâtrerie" Or Sh.Name = "divers" Or Sh.Name = "Parquet" Or Sh.Name = "prestation" Then
            Me.ComboBox1.AddItem Sh.Name
        End If
    Next
    ListBox1.ColumnCount = 9
    ListBox1.ColumnWidths = "60;80;250;60;40;40;40;40;40;40"
    Me.Label15.Caption = " Recherche d'articles"
End Sub

code dans le module1

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
Option Explicit
Public Ws As Worksheet
 
Sub essai()
    Dim DerL As Long
 
    With Ws
        DerL = .Range("A65536").End(xlUp).Row
        UserForm1.ListBox1.List = .Range("A2:L" & DerL).Value
    End With
 
End Sub
 
Sub Cherche(x As String)
    Dim C As Range, firstAddress As String
 
    Application.ScreenUpdating = False
    With Ws
        Set C = .Columns(3).Find(x, LookIn:=xlValues, lookat:=xlPart)
        If Not C Is Nothing Then
            firstAddress = C.Address
            Do
                If Left(C, Len(x)) = x Then
                    UserForm1.ListBox1.AddItem C.Offset(, -1)
                    UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = C.Offset(, 0)
                    UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 2) = C.Offset(, 1)
                    UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 3) = C.Offset(, 2)
                End If
                Set C = .Columns(3).FindNext(C)
            Loop While Not C Is Nothing And C.Address <> firstAddress
        End If
    End With
    Application.ScreenUpdating = True
 
End Sub
 
 
Sub IniCbo2()
    Dim MonDico As Object, C As Range, firstAddress As String, x As String, DerL As Long
 
    Set MonDico = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = True
 
    With Ws
        DerL = .Range("A65536").End(xlUp).Row
 
        Set C = .Range("C2:C" & DerL).Find("*", LookIn:=xlValues, lookat:=xlWhole)
        If Not C Is Nothing Then
            firstAddress = C.Address
            Do
                x = Mid(C, 1, InStr(C, " ") - 1)
                If Not MonDico.Exists(x) Then MonDico.Add x, x
                Set C = .Range("C2:C" & DerL).FindNext(C)
            Loop While Not C Is Nothing And C.Address <> firstAddress
        End If
    End With
 
    UserForm1.ComboBox2.List = MonDico.items
    Set MonDico = Nothing
    Application.ScreenUpdating = True
 
End Sub

j'ai préparer un exemple si vous le voulez(mais tous les codes sont sur le post)

cordialement

Pascal

[grisan29]

bonjour a vous tous
j'en ai tellement les cheveux ébourriffés que j'ai fini par trouvé, et c'était tout bête car c'était bien le module "cherche" qui était fautif bon voici ce que j'y ai modifié pour que cela fonctionne

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 If Left(C, Len(x)) = x Then
                    UserForm1.ListBox1.AddItem C.Offset(, -2)
                    UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = C.Offset(, -1)
                    UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 2) = C.Offset(, 0)
                    UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 3) = C.Offset(, 1)
                    UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 4) = C.Offset(, 2)
                    UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 5) = C.Offset(, 3)
                    UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 6) = C.Offset(, 4)
                    UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 7) = C.Offset(, 5)
                    UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 8) = C.Offset(, 6)
                End If

voila en rajoutant des lignes et en modifiant certaines valeurs offset et c'est parfait
avec mes excuses de vous avoir dérangé pour si peu

cordialement

Pascal