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 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
| Dim LiCat() As Integer
Dim TabPrix() As Variant
Dim LiElem() As Integer
Dim Cible As Boolean
Dim Valeur As String
Dim reduc As Single
Private Sub BoutonAjout_Click()
'Ajout d ''un élément
Dim i As Integer, fin As Boolean
'Cas n°1 la liste est vide
fin = False
If ListBox1.ListCount = 0 Then
'On ajoute la catégorie puis l'élément
ListBox1.AddItem ComboCat.Value
ListBox1.AddItem ComboElem.Value
If LaUnit.Caption = "forfait" Then
ListBox1.List(1, 1) = 1
Else
ListBox1.List(1, 1) = TextBox1.Value
End If
ListBox1.List(1, 2) = LaUnit.Caption
ListBox1.List(1, 3) = LaPrix.Caption
Else
'Cas n°2 la liste n'est pas vide
'On regarde si un élément de la même catégorie a déjà été entré
For i = 0 To ListBox1.ListCount - 1
'Si oui on ajoute l'élément en dessous
If ComboCat.Value = ListBox1.List(i, 0) Then
ListBox1.AddItem ComboElem.Value, i + 1
If LaUnit.Caption = "forfait" Then
ListBox1.List(i + 1, 1) = 1
Else
ListBox1.List(i + 1, 1) = TextBox1.Value
End If
ListBox1.List(i + 1, 2) = LaUnit.Caption
ListBox1.List(i + 1, 3) = LaPrix.Caption
'un booléen sert à indiquer que l'élément a été ajouté
fin = True
End If
Next i
'Si non on ajoute la catégorie et l'élément à la fin
If fin = False Then
ListBox1.AddItem ComboCat.Value
ListBox1.AddItem ComboElem.Value
If LaUnit.Caption = "forfait" Then
ListBox1.List(ListBox1.ListCount - 1, 1) = 1
Else
ListBox1.List(ListBox1.ListCount - 1, 1) = TextBox1.Value
End If
ListBox1.List(ListBox1.ListCount - 1, 2) = LaUnit.Caption
ListBox1.List(ListBox1.ListCount - 1, 3) = LaPrix.Caption
End If
End If
'Calcul du total
CalcTotal
End Sub
Sub CalcTotal()
Dim Total As Double
If ListBox1.ListCount = 0 Then
Exit Sub
End If
Total = 0
For i = 0 To ListBox1.ListCount - 1
If Not IsNull(ListBox1.List(i, 3)) Then
Total = Total + CDbl(ListBox1.List(i, 3))
End If
Next i
If CheckBox1.Value = True And IsNumeric(TextBox2.Value) And TextBox2.Value <> 0 Then
Dim taux As Single
taux = 1 - TextBox2.Value / 100
reduc = Total * (1 - taux)
Total = Int(Total * taux)
End If
LaPrixTotal.Caption = Total & ""
End Sub
Private Sub BoutonExport_Click()
'Ajout des lignes de commentaires à la listbox
'Pour chaque ligne de la listbox en partant du bas on cherche dans le tableau l'élément correspondant
'si l'indice vaut 1 on insère dans la listbox tous les élément indicés 2 suivants
Dim i, j, n, k As Integer
For i = ListBox1.ListCount - 1 To 0 Step -1
For j = 1 To 123
If ListBox1.List(i, 0) = TabPrix(j, 2) Then
If j = 117 Then
For k = 1 To 6
ListBox1.AddItem TabPrix(j + k, 2), i + k
Next k
Else
n = j + 1
While TabPrix(n, 1) = 2
ListBox1.AddItem TabPrix(n, 2), i + n - j
n = n + 1
Wend
End If
End If
Next j
Next i
'Ajout de la ligne total
If CheckBox1.Value = True And IsNumeric(TextBox2.Value) Then
ListBox1.AddItem "Remise exceptionnelle -" & TextBox2.Value & " %"
ListBox1.List(ListBox1.ListCount - 1, 3) = Int(reduc)
End If
ListBox1.AddItem "Total"
ListBox1.List(ListBox1.ListCount - 1, 3) = LaPrixTotal.Caption
ThisWorkbook.Sheets("Export").Cells.Clear
Dim ligne As Integer
ligne = ListBox1.ListCount
With ThisWorkbook.Sheets("Export")
.Range(.Cells(2, 2), .Cells(1 + ligne, 5)) = ListBox1.List()
.Columns("E:E").NumberFormat = "#,##0.00 $"
.Copy
End With
End Sub
Private Sub CheckBox1_Click()
CalcTotal
End Sub
Private Sub ComboCat_Change()
Dim ligne As Integer
LaElem.Visible = True
ComboElem.Clear
ligne = LiCat(ComboCat.ListIndex + 1) + 1
ComboElem.Visible = True
ReDim LiElem(1 To 1)
Do
If TabPrix(ligne, 1) = 1 Then
n = n + 1
ReDim Preserve LiElem(1 To n)
'on ajoute le texte de la catégorie dans la liste de catégories
ComboElem.AddItem TabPrix(ligne, 2)
'on stock le numéro de la ligne pour retrouver rapidement les éléments
LiElem(n) = ligne
End If
ligne = ligne + 1
If ligne = 124 Then Exit Sub
Loop Until TabPrix(ligne, 1) = 0
End Sub
Private Sub ComboElem_Change()
If Not ComboElem.ListIndex = -1 Then
LaPrixUnitaire.Caption = TabPrix(LiElem(ComboElem.ListIndex + 1), 6)
LaPrixUnitaire.Visible = True
TextBox1.Value = TabPrix(LiElem(ComboElem.ListIndex + 1), 4)
ScrollBar1.Value = CDbl(TextBox1.Value) * 10
TextBox1.Visible = True
ScrollBar1.Visible = True
LaUnit.Caption = TabPrix(LiElem(ComboElem.ListIndex + 1), 3)
LaUnit.Visible = True
Label4.Visible = True
Label1.Visible = True
LaPrix = CStr(CDbl(TextBox1.Value) * CInt(LaPrixUnitaire.Caption))
BoutonAjout.Visible = True
Label5.Visible = True
Label6.Visible = True
End If
End Sub
Private Sub ScrollBar1_Change()
TextBox1.Value = ScrollBar1.Value / 10
LaPrix = CStr(CDbl(TextBox1.Value) * CInt(LaPrixUnitaire.Caption))
End Sub
Private Sub TextBox1_Change()
ScrollBar1.Value = CDbl(TextBox1.Value) * 10
LaPrix = CStr(CDbl(TextBox1.Value) * CInt(LaPrixUnitaire.Caption))
End Sub
Private Sub TextBox2_Change()
CalcTotal
End Sub
Private Sub UserForm_Initialize()
'Entrée de la base de donnée dans une variable pour limiter les échanges excel<->vba
'La BDD fait 123 lignes et 6 colonnes (dont une cachée)
ReDim TabPrix(1 To 123, 1 To 6)
TabPrix = ThisWorkbook.Sheets("BDD").Range("B2:G124").Value
'Initialisation de la liste catégories
Dim i, n As Integer
ReDim LiCat(1 To 1)
n = 0
For i = 1 To 123
'Si la première colonne contient 0, c'est une catégorie
If TabPrix(i, 1) = 0 Then
'on ajoute une catégorie
n = n + 1
ReDim Preserve LiCat(1 To n)
'on ajoute le texte de la catégorie dans la liste de catégories
ComboCat.AddItem TabPrix(i, 2)
'on stock le numéro de la ligne pour retrouver rapidement les éléments
LiCat(n) = i
End If
Next i
End Sub
Private Sub Listbox1_Dblclick(ByVal Cancel As MSForms.ReturnBoolean)
ListBox1.RemoveItem (ListBox1.ListIndex)
End Sub |
Partager