[CODE]
Option Compare Text
Dim f, bd(), Cbx1(), Cbx2()
Private Sub TextBox18_Change()
Dim C, firstAddress
If Len(TextBox18.Text) = 5 Then
ComboVille.Clear
With Feuil2.Range("A2:A" & Feuil2.[A65536].End(3).Row)
Set C = .Find(TextBox18, LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Address
Do
ComboVille.AddItem C.Offset(0, 1)
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
ComboVille.SetFocus
End If
End Sub
Private Sub UserForm_Initialize()
Set f = Sheets("bd")
If f.[B2] = "" Then Exit Sub
bd = f.Range("a2:p" & [a65000].End(xlUp).Row).Value
Me.CbxPaiement.List = Array("ESP", "CHQ", "CB")
Me.ComboPoids.List = Array("40 Kg", "45 Kg", "50 Kg")
Me.ComboPrix.List = Array("170.00 €", "200.00 €", "220.00 €")
Me.ComboJAbbat.List = Array("J 1", "J 2", "J 3")
For i = 1 To UBound(bd, 2) - 1
temp = temp & f.Columns(i).Width * 0.98 & ";"
Me("label" & i) = f.Cells(1, i)
Me("label" & i + 19) = f.Cells(1, i)
Me("label" & i).Top = Me.ListBox1.Top - 20
largeur = largeur + f.Columns(i).Width * 1.05
Next
Me.ListBox1.ColumnWidths = temp: Me.Width = largeur + 10
Me.ListBox1.List = bd
'--
Set d1 = CreateObject("scripting.dictionary")
For i = 1 To UBound(bd)
If bd(i, 2) <> "" Then d1(bd(i, 2)) = ""
Next i
Cbx1 = d1.keys
Call tri(Cbx1, LBound(Cbx1), UBound(Cbx1))
Me.ComboBox1.List = Cbx1
Me.ComboBox1.SetFocus
'--
Set d1 = CreateObject("scripting.dictionary")
For i = 1 To UBound(bd)
If bd(i, 14) <> "" Then d1(bd(i, 14)) = CDate(bd(i, 14))
Next i
Cbx2 = d1.items
Call tri(Cbx2, LBound(Cbx2), UBound(Cbx2))
Me.ComboBox2.List = Cbx2
End Sub
Private Sub ComboBox1_Change()
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
raz
clé1 = UCase(Me.ComboBox1) & "*": clé2 = Me.ComboBox2 & "*"
Dim b()
n = 0: ncol = UBound(bd, 2)
For i = LBound(bd) To UBound(bd)
If UCase(bd(i, 2)) Like clé1 And UCase(bd(i, 14)) Like clé2 Then
n = n + 1: ReDim Preserve b(1 To ncol, 1 To n)
For k = 1 To ncol: b(k, n) = bd(i, k): Next
If bd(i, 2) <> "" Then d1(bd(i, 2)) = ""
If bd(i, 14) <> "" Then d2(bd(i, 14)) = CDate(bd(i, 14))
End If
Next i
If n > 0 Then
ReDim Preserve b(1 To ncol, 1 To n + 1)
Me.ListBox1.List = Application.Transpose(b)
Me.ListBox1.RemoveItem n
Cbx1 = d1.keys
Call tri(Cbx1, LBound(Cbx1), UBound(Cbx1))
Me.ComboBox1.List = Cbx1
If ActiveControl.Name = "ComboBox1" Then Me.ComboBox1.DropDown
Cbx2 = d2.items
Call tri(Cbx2, LBound(Cbx2), UBound(Cbx2))
Me.ComboBox2.List = Cbx2
End If
End Sub
Private Sub ComboBox2_Change()
ComboBox1_Change
End Sub
Sub tri(a, gauc, droi) ' Quick sort
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub
Private Sub B_recup_Click()
nbcol = UBound(bd, 2)
Sheets("Result").Cells.ClearContents
Sheets("Result").Range("A2").Resize(Me.ListBox1.ListCount, nbcol) = Me.ListBox1.List
For i = 1 To nbcol - 1
Sheets("Result").Cells(1, i) = Me("label" & i).Caption
Sheets("Result").Cells(1, i).Font.Bold = True
Next
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.ComboBox1.List = Cbx1
Me.ComboBox1.DropDown
End Sub
Private Sub B_raz_Click()
Me.ComboBox2 = ""
End Sub
Private Sub B_raz1_Click()
Me.ComboBox1 = ""
End Sub
Private Sub ListBox1_Click()
ligne = ListBox1.ListIndex
For i = 0 To 4
Me("textbox" & i + 14) = ListBox1.List(ligne, i)
Next i
For i = 6 To 7
Me("textbox" & i + 14) = ListBox1.List(ligne, i)
Next i
For i = 12 To UBound(bd, 2) - 2
Me("textbox" & i + 14) = ListBox1.List(ligne, i)
Next i
Me.ComboVille = ListBox1.List(ligne, 5)
Me.ComboPoids = ListBox1.List(ligne, 8)
Me.ComboPrix = ListBox1.List(ligne, 9)
Me.CbxPaiement = ListBox1.List(ligne, 10)
Me.ComboJAbbat = ListBox1.List(ligne, 11)
End Sub
Private Sub B_valider_Click()
reservation = Me.TextBox14
Set ligne = f.[A:A].Find(what:=reservation)
If Not ligne Is Nothing Then
lig = ligne.Row
For Each k In Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 14, 15)
tmp = Me("textbox" & k + 13)
If IsNumeric(tmp) Then
f.Cells(lig, k) = CDbl(tmp)
Else
f.Cells(lig, k) = tmp
End If
Next
f.Cells(lig, 6) = Me.ComboVille
f.Cells(lig, 9) = Me.ComboPoids
f.Cells(lig, 10) = Me.ComboPrix
f.Cells(lig, 11) = Me.CbxPaiement
f.Cells(lig, 12) = Me.ComboJAbbat
ligne = ListBox1.ListIndex
bd = f.Range("a2:p" & [a65000].End(xlUp).Row).Value
ComboBox1_Change
Me.ListBox1.ListIndex = ligne
End If
End Sub
Sub raz()
For Each k In Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 14, 15)
Me("textbox" & k + 13) = ""
Next
End Sub