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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
| Private Sub cboFamille_Change()
If cboFamille.ListIndex >= 0 Then
txtQuantite.Text = ""
ChargeServices cboFamille.Value
AutoriseAjout
End If
End Sub
Private Sub CommandButton1_Click()
If MsgBox("Supprimer cette ligne ?", vbYesNo + vbQuestion, "Devis") = vbYes Then
With lstDevis
.RemoveItem .ListIndex
End With
AutoriseValider
End If
End Sub
Private Sub CommandButton2_Click()
.List(.ListCount - 1, 4) = txtQuantite.Text
End Sub
Private Sub lstDevis_Click()
End Sub
Private Sub UserForm_Initialize()
Dim Plage As Range, Cel As Range
Dim Devis As String
Dim L As Long
Dim N As Integer
'Listage des familles
With Sheets("Produits")
Set Plage = .Columns(1).SpecialCells(xlCellTypeConstants, 2)
End With
With cboFamille
For Each Cel In Plage
If Cel.Row > 1 Then
.AddItem Cel.Text
.List(.ListCount - 1, 1) = Cel.Row
End If
Next Cel
.ListIndex = 0
End With
'Numéro de Devis
With Sheets("N°de Devis")
L = .Cells(.Rows.Count, 2).End(xlUp).Row
N = .Cells(L, 4).Value + 1
End With
lblDevis.Caption = "Devis n° A" & Format(Date, "yyyymm") & Format(N, "000")
End Sub
Private Sub btnAjouter_Click()
'Ajoute une ligne dans la liste Devis
With lstDevis
.AddItem cboFamille.Text
.List(.ListCount - 1, 1) = cboServices.Text
.List(.ListCount - 1, 2) = cboServices.List(cboServices.ListIndex, 1)
.List(.ListCount - 1, 3) = cboServices.List(cboServices.ListIndex, 2)
.List(.ListCount - 1, 4) = txtQuantite.Text
End With
cboServices.ListIndex = -1
txtQuantite.Text = ""
AutoriseValider
End Sub
Private Sub cboServices_Change()
AutoriseAjout
End Sub
Private Sub txtQuantite_Change()
AutoriseAjout
End Sub
Private Sub txtQuantite_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = AutoriseKey(KeyAscii)
End Sub
Private Sub txtRemise_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = AutoriseKey(KeyAscii)
End Sub
Private Sub btnAnnuler_Click()
Unload Me
End Sub
Private Sub btnLigne_Click()
lstDevis.AddItem ">>>"
End Sub
Private Sub btnValider_Click()
Dim L As Long
Dim Cumul As Currency
'Numéro du Devis
With Sheets("N°de Devis")
L = .Cells(.Rows.Count, 2).End(xlUp).Row
.Cells(L + 1, 2).Value = Date
.Cells(L + 1, 3).Value = Date
.Cells(L + 1, 4).Value = Val(.Cells(L, 4).Value) + 1
End With
With Sheets("Devis")
'MAJ Devis
.Range("C13").Value = Mid(lblDevis.Caption, 11)
'Effacer les anciennes données
.Range("B17:I35").ClearContents
'Mettre à jour le Devis
For L = 0 To lstDevis.ListCount - 1
If lstDevis.List(L, 1) <> ">>>" Then
.Cells(17 + L, 2).Value = lstDevis.List(L, 1)
.Cells(17 + L, 6).Value = lstDevis.List(L, 2)
.Cells(17 + L, 7).Value = Val(lstDevis.List(L, 4))
.Cells(17 + L, 8).Value = Val(lstDevis.List(L, 3))
.Cells(17 + L, 9).Value = .Cells(17 + L, 7).Value * .Cells(17 + L, 8).Value
Cumul = Cumul + .Cells(17 + L, 9).Value
Columns("b:b").EntireColumn.AutoFit
End If
Next L
If Val(txtRemise.Text) > 0 Then
.Cells(22 + L, 4).Value = "REMISE DE " & Val(txtRemise.Text) & " % >>>"
.Cells(22 + L, 9).Value = CCur(Cumul * Val(txtRemise.Text) / 100) * -1
End If
End With
Unload Me
End Sub
Private Sub ChargeServices(ByVal L As Long)
Dim Lmax As Long
With Sheets("Produits")
Lmax = .Cells(L, 2).End(xlDown).Row
If Lmax = .Cells(L, 1).End(xlDown).Row Then Lmax = L
cboServices.List = .Range(.Cells(L, 2), .Cells(Lmax, 4)).Value
End With
cboServices.ListIndex = -1
End Sub
Private Sub AutoriseAjout()
btnAjouter.Enabled = cboFamille.ListIndex > -1 And cboServices.ListIndex > -1 And Val(txtQuantite.Value) > 0
End Sub
Private Sub AutoriseValider()
btnValider.Enabled = lstDevis.ListCount > 0
End Sub
Private Function AutoriseKey(ByVal A As Integer) As Integer
'Autorise uniquement les saisies de valeurs numériques
Select Case A
Case 44
A = 46
Case 46, 48 To 57
Case Else
A = 0
End Select
AutoriseKey = A
End Function |
