comment crée un numéro de fascture automatique

Dim numero$, NomMemo$ 'mémorisation des variables

Sub EnregistrerModifications()
'Alt+F8 pour exécuter la macro (la feuille doit être vierge)
'évite de déclencher la macro Workbook_BeforeSave
Application.EnableEvents = False
Me.Save
Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
'interdit la modification du numéro de facture et du nom enregistré
Application.EnableEvents = False
With Sheets("Facture de service")
  .[F4] = numero
  If NomMemo <> "" Then .[C10] = NomMemo
End With
  Application.EnableEvents = True
End Sub

Private Sub Workbook_Open()
Dim n As Variant, chemin$, nomfich$
Sheets("Facture de service").Activate 'au cas où...
'---date du jour---
[F5] = Date
'---numéro de facture---
chemin = Me.Path & "\" 'chemin du dossier à adapter
nomfich = Dir(chemin & "Numero_Facture.xls*")
If nomfich <> "" Then
  n = ExecuteExcel4Macro("'" & chemin & "[" & nomfich & "]Feuil1'!R1C1")
  n = IIf(Left(n, 4) = CStr(Year(Date)), Val(Mid(n, 9, 4)), 0)
End If
numero = "'" & Format(Date, "yyyymmdd") & Format(n + 1, "0000")
[F4] = numero
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUi As Boolean, Cancel As Boolean)
Dim nom$, chemin$, wb As Workbook
Cancel = True 'rend impossible l'enregistrement manuel
With Sheets("Facture de service")
  nom = Application.Trim(Replace(Replace(.[C10], "Nom", ""), ":", ""))
  nom = Application.Proper(nom) 'majuscule en tête pour le classement
  If nom = "" Then
    MsgBox "Le nom n'a pas été entré..."
    .[C10].Select
  Else
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    chemin = Me.Path & "\" 'chemin du dossier à adapter
    '---création du fichier facture---
    Set wb = Workbooks.Add(xlWBATWorksheet)
    .Copy After:=wb.Sheets(1)
    wb.Sheets(1).Delete
    wb.Sheets(1).Name = .[F4]
    On Error Resume Next
    MkDir chemin & nom 'création du sous-dossier s'il n'existe pas
    wb.SaveAs chemin & nom & "\" & .[F4] 'enregistrement
    wb.Close
    NomMemo = .[C10] 'mémorisation
    '---mémorisation du numéro de facture---
    Workbooks("Numero_Facture").Close False 'si le fichier est ouvert
    Set wb = Workbooks.Add(xlWBATWorksheet)
    .[F4].Copy wb.Sheets(1).[A1]
    wb.Sheets(1).Protect "TOTO" 'mot de passe à adapter
    wb.SaveAs chemin & "Numero_Facture" 'enregistrement
    wb.Close
  End If
End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Me.Saved = True 'évite l'invite
End Sub

nom = Application.Trim(Replace(Replace(.[C10], "Nom", ""), ":", ""))

Dim numero$, NomMemo$ 'mémorisation des variables

Sub EnregistrerModifications()
'Alt+F8 pour exécuter la macro (la feuille doit être vierge)
'évite de déclencher la macro Workbook_BeforeSave
Application.EnableEvents = False
Me.Save
Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
'interdit la modification du numéro de facture et du nom enregistré
Application.EnableEvents = False
With Sheets("Facture de service")
  .[F4] = numero
  If NomMemo <> "" Then .[C10] = NomMemo
End With
Application.EnableEvents = True
End Sub

Private Sub Workbook_Open()
Dim chemin$, nomfich$, n As Variant
Sheets("Facture de service").Activate 'au cas où...
'---date du jour---
[F5] = Date
'---numéro de facture---
chemin = Me.Path & "\" 'chemin du dossier à adapter
nomfich = Dir(chemin & "Numero_Facture.xls*")
If nomfich <> "" Then
  n = ExecuteExcel4Macro("'" & chemin & "[" & nomfich & "]Feuil1'!R1C1")
  n = IIf(Left(n, 4) = CStr(Year(Date)), Val(Mid(n, 9)), 0)
End If
numero = "'" & Format(Date, "yyyymmdd") & Format(n + 1, "0000")
[F4] = numero
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUi As Boolean, Cancel As Boolean)
Dim der%, nom$, chemin$, wb As Workbook
Cancel = True 'rend impossible l'enregistrement manuel
With Sheets("Facture de service")
  der = InStr(.[C10], ":")
  If der = 0 Then MsgBox _
    "Il faut : (2 points) après ""Nom"" en C10 !!", 48: Exit Sub
  nom = Application.Trim(Mid(.[C10], der + 1))
  nom = Application.Proper(nom) 'majuscule en tête pour le classement
  If nom = "" Then
    MsgBox "Le nom n'a pas été entré..."
    .[C10].Select
  Else
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    chemin = Me.Path & "\" 'chemin du dossier à adapter
    '---création du fichier facture---
    Set wb = Workbooks.Add(xlWBATWorksheet)
    .Copy After:=wb.Sheets(1)
    wb.Sheets(1).Delete
    wb.Sheets(1).Name = .[F4]
    On Error Resume Next
    MkDir chemin & nom 'création du sous-dossier s'il n'existe pas
    wb.SaveAs chemin & nom & "\" & .[F4] 'enregistrement
    wb.Close
    If Dir(chemin & nom & "\*") = "" Then _
      MsgBox "Caractère interdit dans le nom !", 48: Exit Sub
    NomMemo = .[C10] 'mémorisation
    '---mémorisation du numéro de facture---
    Workbooks("Numero_Facture").Close False 'si le fichier est ouvert
    Set wb = Workbooks.Add(xlWBATWorksheet)
    .[F4].Copy wb.Sheets(1).[A1]
    wb.Sheets(1).Protect "TOTO" 'mot de passe à adapter
    wb.SaveAs chemin & "Numero_Facture" 'enregistrement
    wb.Close
  End If
End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Me.Saved = True 'évite l'invite
End Sub