Discussion :

[rodolphenc]

J'ai des quantités prédéfinit mais ils arrivent parfois que je doivent les changer.
c'est pourquoi je souhaiterai ajouter un bouton pour modifier mes quantités dans ma listbox,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Merci pour votre aide,