[XL] Incrémenter un n° de facture

Morcerf

XLDnaute Nouveau
Bonjour à tous,

Je viens de reprendre un fichier excel créé par un prédécesseur. Il doit générer un n° de facture en fonction de la date de réception de la facture. La codification est la suivante :

- Deux derniers chiffres de l'année ( ex 2011=11) + N° du mois + N° chrono ( ce n° chrono est directement lié au mois de la facture) + A

Par exemple,
- La première facture de novembre 2011 sera: 111101A
- La seconde facture de novembre 2011 sera: 111102A
- La première facture de décembre 2011 sera: 111201A

Cette macro générait ce n°,

Sub Numbering()

'go to sheet "Base de données FRAIS EUROS"
Sheets("Base de données FRAIS EUROS").Select

'sorting
ActiveWorkbook.Worksheets("Base de données FRAIS EUROS").ListObjects("Tableau1" _
).Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Base de données FRAIS EUROS").ListObjects("Tableau1" _
).Sort.SortFields.Add Key:=Range( _
"Tableau1[[#Headers],[#Data],[NOUVEAU NUMERO FACTURE]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Base de données FRAIS EUROS").ListObjects( _
"Tableau1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'Find the last used cell, before a blank in a Column:
Range("A1").End(xlDown).Select

Dim nn As String 'nn: new number

If Left(Selection.Offset(-6, 2).Value, 2) = Right(CStr(Year(Date)), 2) _
And Mid(Selection.Offset(-6, 2).Value, 3, 2) = CStr(Month(Date)) Then

nn = Format(Mid(Selection.Offset(-6, 2).Value, 5, 2) + 1, "00")

Else

nn = "01"

End If

NouveauNumeroFacture = Right(CStr(Year(Date)), 2) & CStr(Month(Date)) & nn & "A"

UserForm1.TextBox2.Value = NouveauNumeroFacture

Aujourd'hui, elle me donne invariablement comme n° 12101A. Je suis débutant en macro et je peine à détecter la source du problème. Pourriez-vous m'aider à trouver la solution ?

Merci d'avance
 

JNP

XLDnaute Barbatruc
Re : [XL] Incrémenter un n° de facture

Bonjour Montcerf et bienvenue :),
Ton prédécesseur n'a pas du faire 3 mois, car il n'a pas tenu compte des mois avant octobre :rolleyes:...
Essaie de corriger ces 2 parties de code
Code:
If Left(Selection.Offset(-6, 2).Value, 2) = Right(CStr(Year(Date)), 2) _
And Mid(Selection.Offset(-6, 2).Value, 3, 2) = CStr(Format(Month(Date), "00")) Then
Code:
NouveauNumeroFacture = Right(CStr(Year(Date)), 2) & CStr(Format(Month(Date), "00")) & nn & "A"
Si pas ça, revient avec ton fichier anomysé (remplacement des données confidentielles par des données factices) :p...
Bon courage :cool:
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : [XL] Incrémenter un n° de facture

Bonjour le fil, bonjour le forum,

Peut-être comme ça (à peine testé)... :
Code:
Sub Numbering()
Dim dv As Range 'déclare la variable dv (Dernière Valeur)
Dim dn As String 'déclare la variable dn (Dernier Numéro)
Dim p As Byte, a As Byte 'déclare les variables p (deux Premiers caractères) et a (Année)
Dim s As Byte, m As Byte 'déclare les variables s (deux Seconds caractères) et m (Mois)
Dim t As Byte, n As Byte 'déclare les variables t (deux Troisièmes caractères) et n (Numéro)
Dim NouveauNumeroFacture As String 'déclare la variable NouveauNumeroFacture

'go to sheet "Base de données FRAIS EUROS"
Sheets("Base de données FRAIS EUROS").Select
'sorting
ActiveWorkbook.Worksheets("Base de données FRAIS EUROS").ListObjects("Tableau1" _
).Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Base de données FRAIS EUROS").ListObjects("Tableau1" _
).Sort.SortFields.Add Key:=Range( _
"Tableau1[[#Headers],[#Data],[NOUVEAU NUMERO FACTURE]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Base de données FRAIS EUROS").ListObjects( _
"Tableau1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'Find the last used cell, before a blank in a Column:
Set dv = Range("A1").End(xlDown)
dn = dv.Value 'définit le dernier numéro
p = CByte(Left(dn, 2)) 'définit les 2 premiers caractères
s = CByte(Mid(dn, 3, 2)) 'définit les 2 caractères suivants
t = CByte(Mid(dn, 5, 2)) 'définit les 2 caractères suivants
If Right(Year(Date), 2) = p Then 'condition : si les deux derniers caractères de l'année en cours correspondent à p
    a = p 'définit l'année
Else 'sinon
    a = p + 1 'définit l'année a (en incrémentant de +1)
End If 'fin de la condition
If Month(Date) = s Then 'condition : si le mois de la date en cours et s correspondent
    m = s 'définit le mois en cours
    n = Format(t + 1, "00") 'incrémente le numéro
Else 'sinon
    m = (s + 1) Mod 12 'incrémente le mois
    If (s + 1) = 13 Then a = a + 1 'si on passe de décembre à janvier l'année s'incrémente
    n = "01" 'définit le numéro comme étant le premier du mois
End If 'fin de la condition
NouveauNumeroFacture = a & Format(m, "00") & n & "A" 'place le nouveau numéro de facture
UserForm1.TextBox2.Value = NouveauNumeroFacture
End Sub
 

Morcerf

XLDnaute Nouveau
Re : [XL] Incrémenter un n° de facture

Bonsoir à tous et merci beaucoup pour votre aide. Je ne parviens cependant pas à aboutir au bon résultat, le n° de facture demeurant malgrè vos propositions le même sans que je comprenne sa provenance. Je n'arrive pas à mettre le fichier en pièce jointe :confused:. Puis-je l'envoyer à l'un d'entre vous par mail pour que vous m'aidiez ?

Point positif, je parviens malgrè tout à obtenir le n° de facture par une formule excel un brin alambiquée pas complétement du goût de mon chef :).

Bonne soirée
 

Bebere

XLDnaute Barbatruc
Re : [XL] Incrémenter un n° de facture

bonjour Morcef,Robert,Mj13

à tester
Code:
Sub f()
Dim nn As String 'nn: new number
Dim dern As String
'Find the last used cell, before a blank in a Column:
dern = Range("A1").End(xlDown).Value

'année
If Left(dern, 2) = Mid(Year(Date), 3) Then
nn = Mid(dern, 1, 2)
Else
nn = Mid(Year(Date), 3)
End If
'mois
If Mid(dern, 3, 2) = Format(Month(Date), "00") Then
nn = nn & Mid(dern, 3, 2)
Else
nn = nn & Format(Month(Date), "00")
End If
'incrément
If Left(dern, 2) = Mid(Year(Date), 3) And Mid(dern, 3, 2) = Format(Month(Date), "00") Then
nn = nn & Format(Mid(dern, 5, 2) + 1, "00") & "A"
Else
nn = nn & "01A"
End If

'Range("A1").End(xlDown).Offset(1, 0).Value = nn

End Sub
 

mikeo

XLDnaute Occasionnel
Re : [XL] Incrémenter un n° de facture

Bonjour Morcerf, le forum,
et mes maîtres Robertn JNP, Berbère, MJ13,

Tout d'abord bonne année à tous,

@Morcerf, j'ai résolu le même problème il y a quelques années avec un code qui m'a été donné ici (Je n'ai pas noté l'auteur mais il est peut êtr de Papounet ou Robert, mais je me trompe peut être). Je l'utilise toujours, merci.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Plage As Range, I As Long, J As Long, K As Long
With Sheets("bd")
If Target.Address <> "$C$28" Then Exit Sub
I = .Range("A:A").SpecialCells(xlCellTypeConstants).Row
J = .Range("A:A").SpecialCells(xlCellTypeConstants).Rows.Count
For K = I To I + J - 1
If Left(.Cells(K, 1), 4) = Format(Range("C28"), "yymm") Then
If Plage Is Nothing Then
Set Plage = .Cells(K, 1)
Else
Set Plage = Union(Plage, .Cells(K, 1))
End If
End If
Next K
End With
If Not Plage Is Nothing Then
    Range("$C$30") = Application.WorksheetFunction.Max(Plage) + 1
Else
    Range("$C$30") = Format(Range("C28"), "yy") & Format(Range("C28"), "mm") & "01"
End If

End Sub


Il est de mon devoir de le transmettre. A+

Mikeo
 

Pièces jointes

  • FACTURE.xls
    51.5 KB · Affichages: 115
  • FACTURE.xls
    51.5 KB · Affichages: 128
  • FACTURE.xls
    51.5 KB · Affichages: 126

Robert

XLDnaute Barbatruc
Repose en paix
Re : [XL] Incrémenter un n° de facture

Bonjour le fil, bonjour le forum,

Je te propose la correction de ton code comme ci-dessous :
Code:
Sub Numbering()
Dim nn As String    'nn: new number
Dim a As String 'déclare la variable a (Année)
Dim m As String 'déclare la variable m (Mois)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim n As Byte 'déclare la variable n (Numéro)
Dim max As Byte 'déclare la variable max (numéro MAXimal)
Dim NouveauNumeroFacture As String 'déclare la variable NouveauNumeroFacture

a = CStr(Right(Year(Date), 2)) 'définit l'année a
m = CStr(Month(Date)) 'définit le mois m
Set r = Sheets("Base de données FRAIS EUROS").Columns(3).Find(a & m, , xlValues, xlPart) 'définit la recherche r
If Not r Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
    pa = r.Address 'définit l'adresse de la première occurrence
    Do 'éxécute
        Select Case Len(r.Value) 'agit en fonction du nombre de caractères de l'occurrence trouvée
            Case 6 'cas 6 caractères (pour les mois de janvier a septembre)
                If CStr(Left(r.Value, 3)) = a & m Then 'condition 1 : si les trois premiers caractères de l'occurence touvée correspondent à l'année + le mois
                    n = Mid(r.Value, 4, 2) 'définit le numéro n
                    If n > max Then max = n 'si n est supérieur à max alors max devient n
                End If 'fin de la condition 1
            Case 7 'cas 7 caractères (pour les mois d'octobre à décembre)
                If CStr(Left(r.Value, 4)) = a & m Then 'condition 2 : si les quatre premiers caractères de l'occurence touvée correspondent à l'année + le mois
                    n = Mid(r.Value, 5, 2) 'définit le numéro n
                    If n > max Then max = r 'si n est supérieur à max alors max devient n
                End If 'fin de la condition 2
        End Select 'fin de l'action en fonction de...
        Set r = Sheets("Base de données FRAIS EUROS").Columns(3).FindNext(r) 'redéfinit la recherche (occurrence suivante)
    Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe des occurrences ailleurs qu'en pa
End If 'fin de la condition
If max = 0 Then 'condition si max=0 (donc s'il nexiste pas de numéro ce mois-ci)
    nn = "01" 'définit nn
Else 'sinon
    nn = Format(max + 1, "00") 'définit nn
End If 'fin de la condition
NouveauNumeroFacture = a & m & nn & "A" 'définit le NouveauNumeroFacture
UserForm1.TextBox2.Value = NouveauNumeroFacture 'attribue NouveauNumeroFacture comme valeur de la TextBox2 de l'UserForm1
End Sub

Je ne peux pas utiliser le tri du code initial car je n'ai pas la version pour cela. J'ai préféré passer par une recherche de valeur plutôt qu'une boucle sur toutes les cellules. On aurait pu aussi envisager de passer par un filtre...

le fichier :


 

Pièces jointes

  • Morcerf_v01.zip
    347.6 KB · Affichages: 96

Discussions similaires

Réponses
17
Affichages
864