[XL-2019] Problème avec Combobox

1 pièce(s) jointe(s)

Problème avec Combobox

Bonjour à tous,

J'ai repris un exemple de Jacques Boisgontier (merci à lui) pour créer une fiche client......
j'ai un petit soucis avec mon combobox, dès que j'ai plusieurs nom de famille les mêmes avec des prénoms différents, il n'affiche pas les renseignements...j'ai beau cherché l"erreur....je ne vois pas
Pouvez-vous m'aider...

Merci d avance

Oli

Bonjour, peu de gens ouvre les dossiers joints surtout au premier contact, pourriez vous nous mettre la partie du code qui correspond au problème?
Cordialement 8-)

2 pièce(s) jointe(s)

Bonjour,

Exemple avec gestion de doublons nom/prénom

Il est plus simple d'avoir le nom et le prénom dans la même colonne.

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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
Option Compare Text
Dim f, ligneEnreg, Tblclé()
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Tblclé = Range("A2:D" & [a65000].End(xlUp).Row).Value                  ' Nom+Prénom
  For i = 1 To UBound(Tblclé): Tblclé(i, 3) = f.Cells(i + 1, 7): Next i  ' ville
  For i = 1 To UBound(Tblclé): Tblclé(i, 4) = i + 1: Next i              ' index
  Call Tri2Col(Tblclé, LBound(Tblclé), UBound(Tblclé))
  Me.ChoixNom.List = Tblclé
  Me.ChoixNom.SetFocus
End Sub
 
Private Sub ChoixNom_click()
 'on récupère tous les champs
  ligneEnreg = Me.ChoixNom.Column(3)
  AfficheFiche
  Me.ListBox1.Clear
  Me.Existant.Caption = ""
  listeExistants
End Sub
 
Sub AfficheFiche()
  For Each c In Me.Frame_Civilite.Controls
    If f.Cells(ligneEnreg, 3) = c.Caption Then c.Value = True
  Next c
  Me.Controls("TextBox1") = f.Cells(ligneEnreg, 1)
  Me.Controls("TextBox2") = f.Cells(ligneEnreg, 2)
  For k = 3 To 6
      Me.Controls("TextBox" & k) = f.Cells(ligneEnreg, k + 1)
  Next k
End Sub
 
Private Sub B_nouv_Click()
  ligneEnreg = [a65000].End(xlUp).Row + 1
  raz
  Me.TextBox1.SetFocus
End Sub
 
Private Sub B_valid_Click()
    If Me.TextBox1 = "" Or ligneEnreg = 0 Then Me.TextBox1.SetFocus: Exit Sub
    f.Cells(ligneEnreg, 1) = Me.Controls("TextBox1")
    f.Cells(ligneEnreg, 2) = Me.Controls("TextBox2")
    For Each c In Me.Frame_Civilite.Controls
      If c Then f.Cells(ligneEnreg, 3) = c.Caption
    Next c
    For k = 3 To 6
        tmp = Me("TextBox" & k)
        If IsNumeric(tmp) Then tmp = Val(tmp)
        If IsDate(tmp) Then tmp = CDate(tmp)
        f.Cells(ligneEnreg, k + 1) = tmp
    Next k
    raz
    UserForm_Initialize
    ligneEnreg = f.[a65000].End(xlUp).Row + 1
End Sub
 
Sub raz()
  Dim c As Control
  For Each c In Me.Controls
    Select Case TypeName(c)
      Case "TextBox"
        c.Value = ""
      Case "CheckBox"
        c.Value = False
      Case "ListBox", "ComboBox"
        c.ListIndex = -1
      Case "Frame"
        For Each b In c.Controls
          If TypeName(b) = "OptionButton" Then b.Value = False
       Next b
    End Select
  Next c
  Me.ListBox1.Clear
  Me.Existant.Caption = ""
End Sub
 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  listeExistants
End Sub
 
Sub listeExistants()
  Me.Existant.Caption = Me.TextBox1 & " existants"
  Me.ListBox1.Clear
  i = 0
  For Each c In Range("A2:a" & [a65000].End(xlUp).Row)
    If UCase(c) = UCase(Me.TextBox1) Then
      Me.ListBox1.AddItem c
      Me.ListBox1.List(i, 1) = c.Offset(, 1)
      Me.ListBox1.List(i, 2) = c.Offset(, 6)
      Me.ListBox1.List(i, 3) = c.Row
      i = i + 1
    End If
  Next c
End Sub
 
Private Sub ListBox1_Click()
  ligneEnreg = Me.ListBox1.Column(3)
  AfficheFiche
End Sub
 
Sub Tri2Col(a(), gauc, droi)  ' Quick sort
  ref = a((gauc + droi) \ 2, 1) & a((gauc + droi) \ 2, 2)
  g = gauc: d = droi
  Do
    Do While a(g, 1) & a(g, 2) < ref: g = g + 1: Loop
    Do While ref < a(d, 1) & a(d, 2): d = d - 1: Loop
    If g <= d Then
       For k = LBound(a, 2) To UBound(a, 2)
         temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
       Next k
       g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call Tri2Col(a, g, droi)
  If gauc < d Then Call Tri2Col(a, gauc, d)
End Sub

Boisgontier