Microsoft 365 Incrémentation d'un numéro de devis/facture

Heavy_B

XLDnaute Nouveau
Bonjour le forum,

je viens vers vous afin de vous soumettre mon problème.
Je suis occupé à créer un formulaire pour faire des devis/factures et j'aimerais que les numéros s'incrémente via un bouton.
En cherchant un peux j'ai trouvé quelque petite choses mais rien de concluant pour résoudre mon soucis.

Pour planter le décors voici le fonctionnement de mon fichier :
Dans 1 page je remplis les données du devis ou de la facture (y compris les infos clients).
J'ai ensuite la possibilité en appuyant sur un bouton de sauvegarder mon document avec comme forme
soit pour un devis : "c:/MIKE/NomClient PrenomClient/devis_NomClient PrenomClient_n°devis Date_Heure.xlsm"
soit pour une facture "c:/MIKE/NomClient PrenomClient/facture_NomClient PrenomClient_n°facture Date_Heure.xlsm"

donc chaque client à son propre répertoire...
Le but de la "formule magique VBA" serais d'aller voir dans les différents répertoire pour trouver le dernier numéro de devis ou de facture et d'incrémenter le numéro sur ma page principale de 1.
Donc par exemple si mon dernier devis porte le numéro 33 et ma dernière facture le numéro 18, quand j'appuye sur le bouton et suivant ce que j'encôde (défini dans une cellule de la même page) le numéros de devis me donne 34 ou le numéro de facture me donne 19.

J'ai déjà une bonne partie du code mais il me donne une erreur au niveau de la ligne " intMaxInvoice = WorksheetFunction.Max(intMaxInvoice, Mid(strFile, Len(strFile) - 16, 3))"
suivant que je mette -16 ou -18 il me donne "run time error 6 : Overflow" ou "run time error 1004 : Unable to get the max property of the WorksheetFunction class"

Je tiens a préciser que je n'ai pas fait ce code mais que je l'ai récupéré et adapté. Je ne suis pas un utilisateur expérimenté en VBA.

Voici le code :
VB:
Sub GetNextInvoiceNumber()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim strPath As String
    Dim strFolder As String
    Dim strClient As String
    Dim strFile As String
    Dim intMaxInvoice As Integer
    Dim strInvoice As String
    Dim intYear As Integer
    Dim strYear As String

    ' Définir le chemin d'accès
    strPath = "C:\MIKE\"

    ' Choisir le workbook et le worksheet approprié
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Maison type") ' Remplacer par le nom de votre feuille

    ' Récupérer le nom et le prénom du client depuis votre feuille de calcul
    strInvoice = ws.Range("M1").Value ' Remplacer A2 par la cellule contenant le type de document (devis ou facture)

    ' Récupérer l'année en cours
    intYear = Year(Date)
    strYear = CStr(intYear)

    ' Nouveau code pour parcourir tous les sous-dossiers
    Dim FSO As New Scripting.FileSystemObject
    Dim Folder As Scripting.Folder
    Dim Subfolder As Scripting.Folder

    ' Choisir le dossier parent
    Set Folder = FSO.GetFolder(strPath)

    ' Parcourir tous les sous-dossiers
    For Each Subfolder In Folder.SubFolders
        strFile = Dir(Subfolder.Path & "\" & strInvoice & "_" & "*" & "_*")
        ' Parcourir tous les fichiers dans le sous-dossier
        Do While strFile <> ""
            intMaxInvoice = WorksheetFunction.Max(intMaxInvoice, Mid(strFile, Len(strFile) - 16, 3))
            strFile = Dir
        Loop
    Next Subfolder

    ws.Range("C3").Value = strYear & Format(intMaxInvoice + 1, "000")

End Sub
 
Solution
Bonjour,

je viens de tester la méthode de Sylvanu et en modifiant légérement le code cela fonctionne, il faudra juste introduire manuellement le premier numéro de chaque année manuellement.
Voici le code :
VB:
Sub GetNextInvoiceNumber()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim strPath As String
    Dim strFolder As String
    Dim strClient As String
    Dim strFile As String
    Dim intMaxInvoice ' As Integer
    Dim strInvoice As String
    Dim intYear As Integer
    Dim strYear As String

    ' Définir le chemin d'accès
    strPath = "C:\MIKE\"

    ' Choisir le workbook et le worksheet approprié
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Maison type") ' Remplacer par le nom de votre feuille...

mapomme

XLDnaute Barbatruc
Supporter XLD
Le devis "Dev0010" peut sans problème devenir la "Fact0020" sans pour autant qu'il existe de facture "Fact0001" dès l'instant que le nº est univoque !
L'unicité du numéro est une condition nécessaire mais pas suffisante.

J'arrête ici... Il est temps d'aller au lit rejoindre les bras de Morphée. Bonne-nuit @dysorthographie ;)🥱 😴,

Juste pour complément, voir ici : https://entreprendre.service-public.fr/vosdroits/F31808
Je cite:
MentionsCommentaires
Date de l'émission de la factureDate à laquelle elle est émise.
Numérotation de la factureNuméro unique basé sur une séquence chronologique continue, sans rupture. Exemple : facture 01, 02, 03.
Il est cependant possible d'émettre des séries distinctes lorsque les conditions d'exercice de l'activité le justifient. L'entreprise peut utiliser un préfixe par année (2022-XX) ou par année et mois (2022-01-XX).
Par exemple, si celle-ci termine le mois de janvier avec une facture numérotée 25 :
- Janvier : facture n° 2022-01-025
- Février : facture n° 2022-02-026
À faire figurer sur toutes les pages de la facture
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Personnellement je feraiune numérotation part type de documents, mais le poste #1 ma fait penser que le demandeur souhaitait par client !

Il me semble que quelque soit la forme de numérotation il est préférable que ce soit centralisée dans un endroit connu plutôt que d'autopsier les fichiers existant dans le ou les répertoire client !
Tout à fait d'accord avec toi.
Mais une numérotation par client n'est pas autorisée. Par type de document, oui (Dev, Fact, ...)
Nous étions donc d'accord depuis le début :) 👍 :D.
 

Heavy_B

XLDnaute Nouveau
Personnellement je feraiune numérotation part type de documents, mais le poste #1 ma fait penser que le demandeur souhaitait par client !

Bonjour, désolé pour la réponse tardive mais je suis en congé sans accès a mon PC.
Je n'ai pas encore essayé les différents codes donné dans cette discution mais je voudrais préciser que ma demande concerne bien un numéro d'ordre par type de document et non par client.

Merci
 

Heavy_B

XLDnaute Nouveau
Bonjour,

je viens de tester la méthode de Sylvanu et en modifiant légérement le code cela fonctionne, il faudra juste introduire manuellement le premier numéro de chaque année manuellement.
Voici le code :
VB:
Sub GetNextInvoiceNumber()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim strPath As String
    Dim strFolder As String
    Dim strClient As String
    Dim strFile As String
    Dim intMaxInvoice ' As Integer
    Dim strInvoice As String
    Dim intYear As Integer
    Dim strYear As String

    ' Définir le chemin d'accès
    strPath = "C:\MIKE\"

    ' Choisir le workbook et le worksheet approprié
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Maison type") ' Remplacer par le nom de votre feuille

    ' Récupérer le nom et le prénom du client depuis votre feuille de calcul
    strInvoice = ws.Range("M1").Value ' Remplacer A2 par la cellule contenant le type de document (devis ou facture)

    ' Récupérer l'année en cours
    intYear = Year(Date)
    strYear = CStr(intYear)

    ' Nouveau code pour parcourir tous les sous-dossiers
    Dim FSO As New Scripting.FileSystemObject
    Dim Folder As Scripting.Folder
    Dim Subfolder As Scripting.Folder

    ' Choisir le dossier parent
    Set Folder = FSO.GetFolder(strPath)

    ' Parcourir tous les sous-dossiers
    For Each Subfolder In Folder.SubFolders
         strFile = Dir(Subfolder.Path & "\" & strInvoice & "_" & "*" & "_*")
        ' Parcourir tous les fichiers dans le sous-dossier
        Do While strFile <> ""
            T = Split(strFile, "_")         ' Séparateur : "_"
            ' Année = Val(Left(T(2), 4))      ' Extraction de l'année
            ' Numéro = Val(Mid(T(2), 5, 3))   ' Extraction du N°
            Numéro = Val(Left(T(2), 7))
            intMaxInvoice = WorksheetFunction.Max(intMaxInvoice, Numéro)
            strFile = Dir
        Loop
    Next Subfolder

    ' ws.Range("C3").Value = strYear & Format(intMaxInvoice + 1, "000")
    ws.Range("C3").Value = Format(intMaxInvoice + 1, "000")

End Sub
 

dysorthographie

XLDnaute Accro
bonjour,
perso je sauvegarderai les derniers N° dans un onglet . je ne parcourrai pas les 150 000 répertoire pour trouver le dernier N°!



avant traitement
1691149853522.png

Après traitement
1691149953444.png


VB:
Public Function AutoIncrement(TypeDoc As String) As String
Dim L As Integer
With ThisWorkbook.Sheets("N° Incrémental")
    L = SerchXls(.Range("A:A"), .Range("A1"), TypeDoc, True)
    If L = 0 Then L = .Cells(.Cells.Rows.Count, "A").End(xlUp).Row + 1
  
    If .Cells(L, "C") <> Year(Date) Then
        .Cells(L, "B") = 0
        .Cells(L, "C") = Year(Date)
    End If
    .Cells(L, "A") = TypeDoc
 
        .Cells(L, "B") = .Cells(L, "B") + 1
        AutoIncrement = Format(.Cells(L, "B"), "000")

End With
End Function
'devis_NomClient PrénomClient_2022048 11-07-23_10-02.xlsm
Function Numerot(NomClient As String, PrenomClient As String, TypeDoc As String)
Const Repertoire As String = "c:\MIKE\[NomClient] [PrenomClient]\"
Const Doc As String = "[TypeDoc]_[NomClient] [PrenomClient]_[n°] [Date]_[Heure].xlsm"
Dim Rep As String
Rep = Replace(Replace(Repertoire, "[NomClient]", NomClient), "[PrenomClient]", PrenomClient)
Creer_Repertoires Rep
    
        Numerot = Rep & Replace(Replace(Replace(Replace(Replace(Replace(Doc, "[NomClient]", NomClient), "[PrenomClient]", PrenomClient), "[n°]", AutoIncrement(TypeDoc)), "[Date]", Format(Date, "dd-mm-yy")), "[Heure]", Format(Now, "hh-mm")), "[TypeDoc]", TypeDoc)

End Function

Sub test()

MsgBox Numerot("dysorthographie", "Robert", "devis")
MsgBox Numerot("dysorthographie", "Robert", "facture")
MsgBox Numerot("dysorthographie", "Robert", "avoir")

End Sub
 

Pièces jointes

  • AutoIncrémént.xlsm
    28.6 KB · Affichages: 5
Dernière édition:

Heavy_B

XLDnaute Nouveau
Bonjour dysorthographie,
J'ai aussi essayé votre méthode mais, sauf si je me trompe, celle-ci incrémente tous les type de fichier en même temps, ce qui ne m'arrange pas vraiment car c'est par type de document que je voulais incrémenter.
Mais merci quand même
 

dysorthographie

XLDnaute Accro
à mon avis tu n'as pas regardé les imprimes écran de mon dernier poste!

VB:
Sub test()

MsgBox Numerot("dysorthographie", "Robert", "devis") 'tu choisi le type de document
MsgBox Numerot("dysorthographie", "Robert", "facture")
MsgBox Numerot("dysorthographie", "Robert", "avoir")

End Sub
 

Heavy_B

XLDnaute Nouveau
avec l'avant et l'après, si. J'ai aussi essayé votre fichier en attache, et oui, effectivement lorsque j'exécute la macro celle-ci incrémente les 3 valeurs de document en fonction de l'année, et recommence à 1 si on change l'année.
Et donc, à moins que je rate quelque chose (ce qui est fort possible), je ne sais pas faire une incrémentation d'un seul document à la fois.

EDIT : je n'avais pas vu le code envoyé entretemps, je vais essayer avec cela
 

dysorthographie

XLDnaute Accro
je suis sur que si!
c'est un exemple à toi de l'adapter c'est pas à moi!

Numerot te retourne le chemin complet de sauvegarde du fichier Excel! de plus il ajoute le répertoire s'il n'existe pas!

pour l'exemple des devis:
c:\MIKE\dysorthographie Robert\devis_dysorthographie Robert_002 04-08-23_14-43.xlsm

VB:
Sub test()
MsgBox Numerot("dysorthographie", "Robert", "devis") 'tu choisi le type de document
End Sub
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 206
Messages
2 086 222
Membres
103 158
dernier inscrit
laufin