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 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141
| Option Explicit
Sub AlimListes(chp As Integer, Optional cible)
Dim d As Object, i%, j, ktl$
Set d = CreateObject("Scripting.Dictionary")
If chp < 4 Then
ktl = "ctl" & chp + 4
Else
ktl = "tbxGuide"
End If
If Not IsMissing(cible) Then
With [Champx]
For i = 1 To .Rows.Count
If .Cells(i, chp - 1) = cible Then
Do While .Cells(i + j, chp - 1) = cible
d(.Cells(i + j, chp).Value) = ""
j = j + 1
Loop
Exit For
End If
Next i
If d.Count > 1 Then
Controls(ktl).List = WorksheetFunction.Transpose(d.keys)
Else
j = d.keys
If chp < 4 Then
Controls(ktl).AddItem j(0)
Else
End If
End If
End With
Else
With [Champx]
For i = 1 To .Rows.Count
d(.Cells(i, chp).Value) = ""
Next i
End With
Controls(ktl).List = WorksheetFunction.Transpose(d.keys)
End If
End Sub
Private Sub cbValid_Click()
Dim c As Control
For Each c In Me.Controls
Select Case TypeName(c)
Case "Ctl5", "Ctl6", "Ctl3", "Ctl4", "ComboBox", "ListBox"
If c.Value = "" Then
MsgBox "Saisir Nom du conseiller, Cat?gories et Sup!"
c.SetFocus
Exit Sub
End If
End Select
Next c
Dim Blt(1 To 8), i%, n%
For i = 3 To 8
Blt(i) = Controls("ctl" & i).Value
Next i
Blt(1) = Date: Blt(2) = Time
With Worksheets("bdd")
n = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & n).Resize(, 9).Value = Blt
.Range("A" & n).NumberFormat = "[$-F800]jjjj, mmmm jj, aaaa"
.Range("B" & n).NumberFormat = "hh:mm"
End With
Unload Me
Billet.Show
End Sub
Private Sub ctl1_Change()
End Sub
Private Sub ctl2_Change()
End Sub
Private Sub ctl4_Change()
End Sub
Private Sub ctl5_Click()
ctl6.Clear
ctl7.Clear
If ctl5.ListIndex > -1 Then
ctl6.ListIndex = -1
AlimListes 2, ctl5.Value
End If
End Sub
Private Sub ctl6_Click()
ctl7.Clear
If ctl6.ListIndex > -1 Then
ctl7.ListIndex = -1
AlimListes 3, ctl6.Value
End If
End Sub
Private Sub ctl7_Click()
If ctl7.ListIndex > -1 Then
AlimListes 4, ctl7.Value
End If
End Sub
Private Sub Fermer_Click()
Unload Me
End Sub
Private Sub Reset_Click()
Unload Me
Billet.Show vbModeless
End Sub
Private Sub Image1_Click()
End Sub
Private Sub Label21_Click()
End Sub
Private Sub UserForm_Initialize()
With [Champx].Resize(, 4)
.Sort key1:=.Cells(1, 1), order1:=xlAscending, key2:=.Cells(1, 2), order2:=xlAscending, _
key3:=.Cells(1, 3), order3:=xlAscending, Header:=xlNo
End With
ctl1.Value = Date: ctl2.Value = Format(Time, "hh:mm")
ctl4.ListIndex = -1
AlimListes 1
End Sub |
Partager