[XL-2007] Adapter un code vba : LastCel.AutoFill Destination

Adapter un code vba : LastCel.AutoFill Destination

Amis du forum Bonjour,

je reviens vers vous, parce que j'ai bon retourner ce petit bout de code dans tout les sens, avec mes faibles connaissances, je ne trouve pas la soluce.

Voici le code :
Code:

1 2 3 4 5 6 7 8 9 10 11 Worksheets("BD_FACTURES").Activate 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
à l'issue de ce code un numéro de facture est générée.
Ce que je voudrais en faire, c'est simplement l'afficher dans une zone de texte au lieu de le renvoyer vers la feuille BD_FACTURES.
Je n'arrive pas à adapter cette ligne :

Code:

LastCel.AutoFill Destination:=LastCel.Resize(2, 1), Type:=xlFillDefault

Si vous avez la soluce, je suis preneur.
Merci

Bonjour,

L’intérêt principal de ton code, c’est d’enregistrer les numéros de facture suivant un ordre chronologique. Pour définir le nouveau numéro de facture, la procédure a besoin de cet enregistrement. Il faut donc que tu maintiennes le code tel quel.
Si tu souhaites, en plus, afficher ce numéro dans une zone de texte, tu peux compléter ton code avec quelque chose du genre

Code:

ActiveSheet.Shapes("ZoneTexte 1").TextFrame.Characters.Text = LastCel.Offset(1, 0)

Cordialement.

gFZT82,

Merci de m'avoir répondu, même si ce n'est pas exactement la réponse que j'attendais.

Tu as tout à fait raison en disant que le code présenté est prévu pour générer un nouveau numéro d'ordre chronologique à chaque lecture, et je vais compléter en disant qu'il est utlisé comme tel dans la commande validé de mon formulaire (voir ci-dessous).

Mon grand intérêt est de pouvoir récupérer ce code en parallèle lors de l'initialisation du userform, sans courcircuiter son enregistrement lors du déclechement de sa commande dans la séquence valider.

D'ou ma question.
Que je vais donc la reformuler différement.

Est-il possible d'adapter ce code pour que le résultat soit afficher dans un textbox au lieu de la première cellule vide de la colonne B en partant du bas?
Cette séquence aurait lieu lors de l'initialisation du userform.
Quand à celle présente dans la séquence Valider Elle serait remplacé par le renvoi de cette même valeur du textbox dans la première cellule vide de la colonne B en partant du bas, comme cela est déjà prévu pour toutes les autres valeurs du formulaire.

Code:

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

Bonjour,

Le seul point gênant vient de l'utilisation de la copie incrémentée pour la détermination du nouveau numéro de facture.
Dans la solution ci-dessous, j'utilise la fonction split pour séparer la date et le numéro chronologique. Si la date de la dernière facture est identique à la date du jour, j'incrémente le numéro de facture.
Voici le code pour afficher le nouveau numéro de facture dans la TextBox1 de l'Userform1.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Dim VarMois As String, ExVarMois Dim LastCel As Range With Worksheets("BD_FACTURES") Set LastCel = [B65536].End(xlUp) ExVarMois = Split(LastCel, "-") VarMois = Format(Date, "yymmdd") If ExVarMois(0) = VarMois Then UserForm1.TextBox1.Text = ExVarMois(0) & "-" & Format(CStr(ExVarMois(1) + 1), "000") Else UserForm1.TextBox1.Text = VarMois & "-001" End If End With
Cordialement.

Merci gFZT82, pour cette nouvelle proposition avec Split, c'est effectivement le résultat que j'attendais. :ccool: