Intégration d'un numéro de devis / facture automatique

Bonjour le forum,

je suis en train de créer un fichier pour créer des devis/facture mais j'aimerai que le numéro soit automatiquement géré.

Je vauvegarde mes fichiers comme ceci :

C:/Mike/nomduclient/Devis ou facture_nomduclient_numérode devisou facture date_heure.

le numéro de devis/facture se compose de l'année en 4 chiffres suivi de 3 digit pour le numéro d'ordre (par exemple 2023033).

Dans mon fichier j'ai une case avec le choix Devis ou Facture suivant ce que je désire encoder et dans la case suivante le numéro d'ordre.

J'aimerai qu'en appuyant sur un bouton (car je ne veux pas cela en automatique en cas de re-travail sur un devis/facture existant) que j'ai le numéro suivant. Est-ce possible? pouvez-vous m'aider svp car je suis novice en VBA.

Merci

Bonjour,

Un code à tester :

Sub GetNextInvoiceNumber()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim strPath As String
    Dim strFolder 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("Feuil1") ' Remplacer par le nom de votre feuille

    ' Récupérer le nom du client et le type de document depuis votre feuille de calcul
    strFolder = ws.Range("A1").Value ' Remplacer A1 par la cellule contenant le nom du client
    strInvoice = ws.Range("A2").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)

    ' Récupérer le dernier fichier dans le dossier client
    strFile = Dir(strPath & strFolder & "/" & strInvoice & "_*")

    ' Si le dossier est vide, commencer à 1
    If strFile = "" Then
        ws.Range("A3").Value = strYear & "001" ' Remplacer A3 par la cellule où vous voulez afficher le numéro de facture
    Else
        ' Sinon, trouver le fichier avec le numéro de facture le plus élevé et ajouter 1
        Do While strFile <> ""
            intMaxInvoice = WorksheetFunction.Max(intMaxInvoice, Mid(strFile, Len(strFile) - 7, 3))
            strFile = Dir
        Loop
        ws.Range("A3").Value = strYear & Format(intMaxInvoice + 1, "000")
    End If

End Sub

Cet exemple suppose que vous ayez un bouton sur votre feuille de calcul qui exécutera cette macro lorsque vous cliquez dessus.

Vous allez devoir faire quelques modifications au code pour qu'il corresponde à votre propre tableau Excel. Par exemple, vous devrez indiquer où se trouvent le nom du client, le type de document (facture ou devis) et où vous souhaitez afficher le prochain numéro de facture ou de devis dans votre tableau. Ce code n'est pas prévu pour gérer les situations où le dossier que vous avez indiqué n'existe pas. Donc, vous pourriez avoir besoin d'ajouter des éléments au code pour gérer ce genre de situations.

Bonjour Abderrahmane Benali,

merci pour la réponse rapide. Je testerai/adapterai demain car je n'aurai pas le temps aujourd'huis.

Je reviens avec le feedback dès que j'ai essayé.

Bonjour Heavy_B,

Dans NumAuto le chemin est "C:\Mike\" alors que dans Save_excel et save_excel_et_pdf le chemin est "C:\MIKE\". Est-ce normal ?
Le chemin utilisé pour créer le dossier dans le module Save_excel et save_excel_et_pdf est différent de celui utilisé dans le module NumAuto. Est-ce normal ?

Le module NumAuto tente de trouver les fichiers avec un nom spécifique et s'il n'en trouve pas qui correspondent à ce modèle, une erreur peut se produire. Vérifiez que les noms des fichiers dans le répertoire correspondent au format attendu par le code.
Je vous laisse le fichier avec quelques modifications.

En analysant le code j'ai un doute :

Si je lis bien le code il recherche dans le folder client inscrit dans le fichier pour y ajouter un numéro d'ordre, donc si je comprend bien j'aurai un numéro d'ordre par client, correct?

Si oui, ce n'est pas réellement ce que j'aimerais, ce que j'aurais voulu c'est qu'il recherche le dernier numéro en cours et ajouter 1, donc par exemple:

Répretoire Devis client 1

Devis client 1 2023001 01-01-23

Devis client 3 2023004 04-01-03

Répretoire Devis client 2

Devis client 2 2023002 02-01-23

Répretoire Devis client 3

Devis client 3 2023003 03-01-23

le nouveau devis pour le client suivant serai par exemple

Répertoire Devis client 4

Devis client 4 2023005 10-01-23

je précise que je n'arrive pas à modifier le code que vous m'avez fournis, je n'arrive pas à trouver l'erreur...

Je vois ce que vous voulez dire. Vous voulez obtenir le dernier numéro de devis enregistré, peu importe le client. Dans ce cas, le code doit chercher dans tous les dossiers de clients pour obtenir le dernier numéro de devis.

Le code suivant fera cette tâche. Il parcourt tous les sous-dossiers dans le dossier parent C:\MIKE\ pour trouver le plus grand numéro de devis existant et ajoute 1 pour obtenir le numéro du nouveau devis.

Ce code nécessite la référence "Microsoft Scripting Runtime". Pour l'ajouter, allez dans le VBE (Visual Basic Editor) avec Alt+F11, puis dans le menu, choisissez "Outils" -> "Références" et cochez "Microsoft Scripting Runtime".

Voici le nouveau code pour GetNextInvoiceNumber

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
    strClient = ws.Range("C5").Value & " " & ws.Range("C6").Value ' C5 et C6 contiennent le nom et le prénom du client
    strInvoice = ws.Range("F2").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("A3").Value = strYear & Format(intMaxInvoice + 1, "000")

End Sub

Hésitez pas à faire plusieurs tests !

Ca ne fonctionne toujours pas, mais j'ai l'impression dans le code que la recherche ne se fait pas sur la variable "intMaxInvoice".

Dans la partie recherche dans les sous-dossiers il y as :

strFile = Dir(Subfolder.Path & "\" & strInvoice & "_" & "*" & "_*")

ne faudrais t'il pas aussi y placer la variable?

Je ne prétend pas m'y connaitre en VBA, si je dis une bétise je m'en excuse, et j'apprécie fortement votre aide.

J'ai aussi depuis changé le "C:\Mike\" en "C:\MIKE\" pour info

intMaxInvoice

intMaxInvoice

intMaxInvoice

intMaxInvoice

Pourriez-vous préciser ce qui ne fonctionne pas exactement? Recevez-vous un message d'erreur? Si oui, que dit-il?

Pourriez-vous également vérifier que vos fichiers de devis sont bien nommés comme vous l'avez décrit précédemment? Les noms de fichier doivent correspondre à la forme "Devis_client #2023#####-##-##" pour que le code fonctionne correctement.

Concernant le changement de "C:\Mike" en "C:\MIKE", cela ne devrait pas poser de problème. Les chemins de fichiers Windows ne sont pas sensibles à la casse.

En fait cela ne fait rien mis à part noter "2023001" dans la case "C3" du fichier si je l'efface. (notée "A3" dans votre dernier partage de code).

Aucun message d'erreur n'apparais, j'ai même renuméroté manuellement quelque essais mais rien ne change.

Je joins une copie d'écran du folder dans lequel je met les fichiers pour que vous puissiez voir si je rate quelque chose...

Mmh d'accord je vois, le problème persiste. Essayez de modifier la ligne de code suivante :

intMaxInvoice = WorksheetFunction.Max(intMaxInvoice, Mid(strFile, Len(strFile) - 16, 3))

à

intMaxInvoice = WorksheetFunction.Max(intMaxInvoice, Mid(strFile, Len(strFile) - 18, 3))

Faites-moi savoir si cela aide

Bonjour,

Pouvez-vous m'aider svp.

Merci

Bonjour le forum,

J'ai enfin trouvé une solution, merci beaucoup à Abderrahmane Benali pour son début de solution et voici le code :

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

Le premier numéro de chaque année devra être mis manuellement, je regarderai pour le mettre en automatique plus tard (a moins que quelqu'un aie une solutin a me proposer... )