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 221 222 223 224 225 226 227 228 229 230 231 232 233 234
| Option Explicit
'format type des msgbox.
Dim Message As String
Dim Titre As String
Dim Style As Byte
Private Sub CmdEffacer_Click()
Call Initialiser
'Affecte les listes aux ComboBox
Me.CboxIdClient.RowSource = ("BD_CLIENTS!ID_Clients")
Me.CboxIdClient.ListIndex = -1
Me.CboxDesignation.RowSource = ("BD_PRESTATIONS!List_Prestations")
Me.CboxDesignation.ListIndex = -1
'Affecte les Boutons Option sur un même Groupe
OptType1.GroupName = "TypeFacture"
OptType2.GroupName = "TypeFacture"
OptType3.GroupName = "TypeFacture"
'Affecte la date du jour sur ZtxtDate au format dd/mm/yyyy
ZtxtDate.Value = Format(Now(), "dd/mm/yyyy")
End Sub
Private Sub CmdValider_Click()
'On teste les saisies...
If CboxIdClient.Text = Empty Then
MsgBox "Vous devez impérativement entrer ou sélectionner un ID CLIENT !", vbExclamation, "Erreur de sélection !"
CboxIdClient.SetFocus
Exit Sub
End If
If CboxDesignation.Text = Empty Then
MsgBox "Vous devez impérativement sélectionner une référence pour éditer une facture !", vbExclamation, "Sélection Manquante !"
CboxDesignation.SetFocus
Exit Sub
End If
Dim i, N, j
'On teste les options
For i = 1 To 3
N = N + Controls("OptType" & i).Value
Next i
If N = 0 Then
MsgBox "Vous devez impérativement sélectionner un type de facture !", vbExclamation, "Erreur de sélection !"
Exit Sub
End If
'On affecte leur valeur
Dim IdFact As String
For Each j In FrmFacture.TypeFacture.Controls
If j = True Then IdFact = j.Caption
Next j
Worksheets("BD_FACTURES").Activate
Dim NewCel As Double
NewCel = Cells(65536, 2).End(xlUp).Rows.Row + 1
With Range("A" & NewCel & ":Z" & NewCel)
.Insert Shift:=xlDown
.Offset(-1).FillDown
.Offset(-1).SpecialCells(xlCellTypeConstants, 23).ClearContents
End With
Dim VarMois As String, ExVarMois As String
Dim LastCel As Range
Set LastCel = [B65536].End(xlUp)
ExVarMois = Left(LastCel, 6)
VarMois = Format(Date, "yymmdd")
If ExVarMois = VarMois Then
LastCel.AutoFill Destination:=LastCel.Resize(2, 1), Type:=xlFillDefault
Else
LastCel.Offset(1) = VarMois & "-001"
End If
'Enregistrement dans la base de données.
With Sheets("BD_FACTURES")
Range("B" & Val(NewCel)).Value = LastCel.Offset(1)
Range("C" & Val(NewCel)).Value = ZtxtFormeJuridique.Value
Range("D" & Val(NewCel)).Value = ZtxtRaisonSociale.Value
Range("E" & Val(NewCel)).Value = ZtxtCivilite.Value
Range("F" & Val(NewCel)).Value = ZtxtNom.Value
Range("G" & Val(NewCel)).Value = ZtxtPrenom.Value
Range("H" & Val(NewCel)).Value = ZtxtAdresseL1.Value
Range("I" & Val(NewCel)).Value = ZtxtAdresseL2.Value
Range("J" & Val(NewCel)).Value = ZtxtCodePostal.Value
Range("K" & Val(NewCel)).Value = ZtxtVille.Value
Range("L" & Val(NewCel)).Value = CboxIdClient.Value
Range("M" & Val(NewCel)).Value = ZtxtDate.Value
Range("O" & Val(NewCel)).Value = IdFact
End With
Call FormatCellAuto
'Edition de la fature.
Worksheets("Facture").Activate
With Sheets("Facture")
Range("W6").Value = LastCel.Offset(1)
Range("U2").Value = ZtxtFormeJuridique.Value
Range("V2").Value = ZtxtRaisonSociale.Value
Range("W2").Value = ZtxtCivilite.Value
Range("X2").Value = ZtxtNom.Value
Range("Y2").Value = ZtxtPrenom.Value
Range("Z2").Value = ZtxtAdresseL1.Value
Range("AA2").Value = ZtxtAdresseL2.Value
Range("U4").Value = ZtxtCodePostal.Value
Range("V4").Value = ZtxtVille.Value
Range("U6").Value = CboxIdClient.Value
Range("Z6").Value = ZtxtDate.Value
Range("V6").Value = IdFact
Range("P52").Value = ZtxtAcompte.Value
Range("P50").Value = ZtxtRemise.Value / 100
NumeroDL
End With
Unload FrmFacture
Worksheets("Formulaires").Activate
MsgBox "La facture n°" & LastCel.Offset(1) & " à bien été enregistrée !", vbOKOnly, "Opération validée !"
FrmFacture.Show
End Sub
Private Sub NumeroDL()
Dim NumLign As Byte
NumLign = Sheets("Facture").Range("V13").Value
MsgBox NumLign, vbOKOnly, "Opération validée !"
End Sub
Private Sub UserForm_Initialize()
'Affecte les listes aux ComboBox
Me.CboxIdClient.RowSource = ("BD_CLIENTS!ID_Clients")
Me.CboxIdClient.ListIndex = -1
Me.CboxDesignation.RowSource = ("BD_PRESTATIONS!List_Prestations")
Me.CboxDesignation.ListIndex = -1
'Affecte les Boutons Option sur un même Groupe
OptType1.GroupName = "TypeFacture"
OptType2.GroupName = "TypeFacture"
OptType3.GroupName = "TypeFacture"
'Affecte la date du jour sur ZtxtDate au format dd/mm/yyyy
ZtxtDate.Value = Format(Now(), "dd/mm/yyyy")
'On affiche les valeurs initiales des totaux
With Sheets("Facture")
Me.ZtxtSousTot.Text = Range("P49")
Me.ZtxtTVAR.Text = Range("D51")
Me.ZtxtTVAN.Text = Range("D52")
Me.ZtxtMontantDu = Range("P53")
End With
Worksheets("Facture").Activate
End Sub
Private Sub Initialiser()
Dim Ctl As Object
For Each Ctl In Me.Controls
If TypeOf Ctl Is MSForms.TextBox Then
Ctl.Value = ""
ElseIf TypeOf Ctl Is MSForms.ComboBox Then
Ctl.ListIndex = -1
End If
Next Ctl
End Sub
Private Sub CboxIdClient_Change()
Dim Rg As Range
Dim Sh As Worksheet
Set Sh = Worksheets("BD_CLIENTS")
If Me.CboxIdClient.ListIndex > -1 Then
'Recherche l'ID
Set Rg = Worksheets("BD_CLIENTS").Range("A:A").Find(what:=CboxIdClient.Value, LookIn:=xlValues, LookAt:=xlWhole)
'Si ID trouvé on alimente les zones du formulaire en données
If Not Rg Is Nothing Then
Me.ZtxtFormeJuridique.Text = Rg.Offset(0, 1).Value
Me.ZtxtRaisonSociale.Text = Rg.Offset(0, 2).Value
Me.ZtxtCivilite.Text = Rg.Offset(0, 3).Value
Me.ZtxtNom.Text = Rg.Offset(0, 4).Value
Me.ZtxtPrenom.Text = Rg.Offset(0, 5).Value
Me.ZtxtAdresseL1.Text = Rg.Offset(0, 6).Value
Me.ZtxtAdresseL2.Text = Rg.Offset(0, 7).Value
Me.ZtxtCodePostal.Text = Rg.Offset(0, 8).Value
Me.ZtxtVille.Text = Rg.Offset(0, 9).Value
Set Rg = Nothing
End If
Else
Initialiser
End If
End Sub
Private Sub CboxDesignation_Change()
Dim Rg As Range
Dim Sh As Worksheet
Set Sh = Worksheets("BD_PRESTATIONS")
If Me.CboxDesignation.ListIndex > -1 Then
'Recherche de la Référence
Set Rg = Worksheets("BD_PRESTATIONS").Range("A:A").Find(what:=CboxDesignation.Value, LookIn:=xlValues, LookAt:=xlWhole)
'Si Référence trouvée on alimente les zones du formulaire en données
If Not Rg Is Nothing Then
Me.ZtxtPref.Text = Rg.Offset(0, 1).Value
Me.ZtxtRef.Text = Rg.Offset(0, 2).Value
Me.ZtxtPrxUnit.Text = Rg.Offset(0, 6).Value
Set Rg = Nothing
End If
Else
Initialiser
End If
End Sub
Private Sub CmdAnnuler_Click()
Worksheets("Formulaires").Activate
Unload FrmFacture
End Sub
Private Sub ZtxtMontant_Change()
ZtxtMontant.Value = Format(ZtxtMontant, "0.00")
End Sub
Private Sub ZtxtPrxUnit_Change()
ZtxtPrxUnit.Value = Format(ZtxtPrxUnit, "0.00")
End Sub |
Partager