Code vba incrémentation N°

Version imprimable

Bonsoir tt le monde j’ai un souci avec incrémentation n° automatique

Voila j’ai classeur avec deux feuils
feuil Facture
feuil ARCHIVESFAC

Dans la feuil « Facture » j’ai un Bouton nommé sauvegarder, la Cellule « E6 »=date aujourd’hui et la Cellule « E8 » = n° facture qui change a chaque Sauvegarde

j’ai utilise la formule suivant dans "E8" feuil facture

Code:

="Fac-"&TEXTE(STXT(ARCHIVESFAC!A3;5;3)+1;"000")&"-"&MAJUSCULE(TEXTE(E6;"MMM"))

pour avoir ce numéro FAC-001-JUIL

Malheureusement quand je clic sur le Bouton sauvegarde a qui j’ai affecté la macro en bas de texte : elle sauvegarde les n° facture de la cellule ((E8) feuil Facture = Fac-001-JUIL) dans la cellule ((A3) feuil ARCHIVESFAC) en chiffres 1.2.3…, et la formule de la Cellule (« E8 » = n° facture) elle s’efface et remplace par « =(ARCHIVESFAC!A3)+1 »

et que elle es sensé sauvegarder le n° de cette manier Fac-001-JUIL, Fac-002-JUIL.... et le dernier n° doit toujours être sauvegarder a la cellule ((A3) feuil ARCHIVESFAC) comme si le cas actuellement avec les chiffre

puis aprés la sauvegarde la cellule (E8) feuil Facture Affiche FAC-002-JUIL) (+1)
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 « Sub Enregistrer_Cliquer() myyear = Year(Range("E6")) couryear = Year(Now) If myyear = couryear Then GoTo suite Else MsgBox ("ATTENTION! soit tu as rentré une date qui n'appartient pas à l'année en cours, soit tu n'as pas respecté le format de date (JJ/MM/AA), soit tu as oublié d'inscrire la date !") Range("E6").ClearContents Exit Sub suite: Style = vbOKCancel Reponse = MsgBox("As-tu bien tout vérifié, parce qu'après c'est plus compliqué de modifier (il faut aller dans le listing). Si c'est bon, clique sur OK ", Style) If Reponse = vbCancel Then Exit Sub ActiveSheet.Unprotect Worksheets("ARCHIVESFAC").Select Worksheets("ARCHIVESFAC").Rows(3).Select Selection.Insert Range("A3").Select Range("A3").Select Range("A3").Formula = "=MAX(A4:A50000)+1" Selection.Copy Selection.PasteSpecial Paste:=xlValues Range("A1").Select Range("B3").Formula = "=FACTURE!E6" Range("C3").Formula = "= FACTURE!E10" Range("D3").Formula = "= FACTURE!E2" Range("E3").Formula = "= FACTURE!E4" 'selectionne la feuille des commandes Worksheets("Facture").Select Range("E6").Select Range("E6") = Now Exit Sub End Sub
merci d'avance pour votre aide et j’espère que j'ai bien exposer mon problème

Bonjour,

Pas sûr d'avoir tout bien compris, mais essayez cela quand même

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
 
Option Compare Text
 
Sub Enregistrer_Cliquer()
    myyear = Year(Range("E6"))
    couryear = Year(Now)
    If myyear = couryear Then
        Style = vbOKCancel
        Reponse = MsgBox("As-tu bien tout vérifié, parce qu'après c'est plus compliqué de modifier (il faut aller dans le listing). Si c'est bon, clique sur OK ", Style)
        If Reponse = vbCancel Then Exit Sub
        ActiveSheet.Unprotect
        Worksheets("ARCHIVESFAC").Select
        Rows(3).Insert
        Range("A3") = Application.WorksheetFunction.Max(Range("A4:A50000")) + 1
        Range("B3") = Sheets("FACTURE").Range("E6")
        Range("C3") = Sheets("FACTURE").Range("E10")
        Range("D3") = Sheets("FACTURE").Range("E2")
        Range("E3") = Sheets("FACTURE").Range("E4")
        'selectionne la feuille des commandes
        Worksheets("Facture").Range("E6") = Now
    Else
        MsgBox ("ATTENTION! soit tu as rentré une date qui n'appartient pas à l'année en cours, soit tu n'as pas respecté le format de date (JJ/MM/AA), soit tu as oublié d'inscrire la date !")
        Worksheets("Facture").Range("E6").ClearContents
    End If
End Sub

Je vois que vous déprotégé la feuille"Facture", Quand la reprotégez-vous?

Cdlt

24/07/2020, 15h49
anissa5
bonjour Mr ARTURO83 merci pour ton aide je vais essayer d’être claire

le bute du code vba que j'ai poste et de me permettre d'archiver mes facture avec les n° incrimenter automatique dans la cellule ("E8" feuil facture ) dans la feuil (ARCHIVESFAC cellule ("A3")) et qui fonction bien avec le code vba que j'ai poste.

je me excuse j'ai pas noté dans mon message précédent que j'utilise ce code dans Workbook et si de la que viens mon problème.
Code:

1 2 3 4 5 6 Private Sub Workbook_SheetActivate(ByVal Sh As Object) If Sh.Name = "Facture" Then Range("E8").Select Range("E8").Formula = "=(ARCHIVESFAC!A3)+1" End If End Sub
ce code me permit d'incrémenter les n° facture en chiffre 1.2.3....... a chaque sauvegarde.
Et je souhait Bien incrémenté les n° de cette manière Fac-001-JUIL. Fac-002-JUIL....a chaque sauvegarde

Ma Question es ce que ya moyen de remplacé cette ligne Qui incrémenter les n° facture en chiffre 1.2.....

Code:

Range("E8").Formula = "=(ARCHIVESFAC!A3)+1"

par cette ligne qui va me permettre d'incrémenter les n° facture de cette manière Fac-001-JUIL. Fac-002-JUIL....

Code:

="Fac-"&TEXTE(STXT(ARCHIVESBDC!A3;5;3)+1;"000")&"-"&MAJUSCULE(TEXTE(E6;"MMM"))

merci inféniment

Bonjour,

Ceci:

Code:

1
2
3
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name = "Facture" Then Range("E8").FormulaR1C1 = "=""Fac-""&TEXT(MID(ARCHIVESBDC!R[-5]C[-4],5,3)+1,""000"")&""-""&UPPER(TEXT(R[-2]C,""MMM""))"
End Sub

Cdlt

25/07/2020, 00h25
anissa5

1 pièce(s) jointe(s)
merci inféniment Mr ARTURO83 le code fonction très bien

j'ai autre chose a vous demander si ça vous dérange pas.

j'ai un autre problème sur le même classeur quand je clic sur le bouton 1 sur ma Facture pour sauvegarder les données; le N° Fac-001-JUIL dans la cellule (E8) est enregistrer sou la forme des chiffre 1,2.... ) sur la feuil ARCHIVESBDC normalement il doit être enregistrer comme suit Fac-001-JUIL plus un a chaque sauvegarde

et la cellule ((E8) Facture) affiche ça #VALEUR! après la première sauvegarde

je pense que le problème viens de la ligne 2 du bout de code en bas du texte affecté au bouton 1 de sauvegarde se qui fait que je n'arrive pas a sauvegarder mes numéro incrémenté sur ma feuil Facture (E8) de cette maniéré Fac-001-JUIL puis Fac-002-JUIL....... sur la feuil ARCHIVESBDC .
Code:

1 2 3 4 5 Range("A3").Select Range("A3").Formula = "=MAX(A4:A50000)+1" Selection.Copy Selection.PasteSpecial Paste:=xlValues Range("A1").Select
je vous joins mon classeur pour bien voir le problème
merci

Bonjour,

le fichier
Pièce jointe 575816

Le code dans le module standard

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
Option Compare Text
 
Sub Enregistrer_Cliquer()
    Dim MyYear As Long, CourYear As Long
    Dim Reponse As String
    Dim NewFac As Long, DerLig As Long
 
    MyYear = Year(Range("E6"))
    CourYear = Year(Now)
    If MyYear = CourYear Then
        Style = vbOKCancel
        Reponse = MsgBox("As-tu bien tout vérifié, parce qu'après c'est plus compliqué de modifier (il faut aller dans le listing). Si c'est bon, clique sur OK ", Style)
        If Reponse = vbCancel Then Exit Sub
        ActiveSheet.Unprotect
        Worksheets("ARCHIVESBDC").Select
        Rows(3).Insert
        DerLig = Range("A" & Rows.Count).End(xlUp).Row
        If DerLig = 2 Then
            DerLig = 4
            NewFac = 1
        Else
            Range("F4:F" & DerLig).FormulaR1C1 = "=IF(RC[-5]<>"""",MID(RC[-5],5,3)*1,"""")"
            NewFac = Application.WorksheetFunction.Max(Range("F4:F50000")) + 1
        End If
        Range("A3").Value = "Fac-" & Format(NewFac, "000") & "-" & UCase(Format(Month(Sheets("Facture").Range("E6")), "MMM"))
        Columns(6).ClearContents
        Range("B3") = Sheets("FACTURE").Range("E6")
        Range("C3") = Sheets("FACTURE").Range("E10")
        Range("D3") = Sheets("FACTURE").Range("E2")
        Range("E3") = Sheets("FACTURE").Range("E4")
        'selectionne la feuille des commandes
        Worksheets("Facture").Range("E6") = Now
    Else
        MsgBox ("ATTENTION! soit tu as rentré une date qui n'appartient pas à l'année en cours, soit tu n'as pas respecté le format de date (JJ/MM/AA), soit tu as oublié d'inscrire la date !")
        Worksheets("Facture").Range("E6").ClearContents
    End If
End Sub

Concernant la formule qui réécrit le N° de bon dans la feuille "Facture", je l'ai modifié pour qu'elle prenne le N°1 dans le cas ou il n'y aurait pas encore de Facture archivée, modification dans ThisWorkbook.

Code:

1
2
3
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name = "Facture" Then Range("E8").FormulaR1C1 = "=IF(ARCHIVESBDC!R3C1="""",""Fac-001-""&UPPER(TEXT(R[-2]C,""MMM"")),""Fac-""&TEXT(MID(ARCHIVESBDC!R[-5]C[-4],5,3)+1,""000"")&""-""&UPPER(TEXT(R[-2]C,""MMM"")))"
End Sub

Question:
Etes-vous sûre que le nombre de factures n'excèdera pas 999? sinon il faut revoir la façon d'extraire le N°.

Cdlt

merci infiniment pour le temps que ta pris pour m'aidé Mr ARTURO83

finalement j'ai résolut le problème j'ai Modifier la 2 ligne du code
Code:

1 2 3 4 5 Range("A3").Select Range("A3").Formula = "=MAX(A4:A50000)+1" Selection.Copy Selection.PasteSpecial Paste:=xlValues Range("A1").Select
Par celle la

Code:

Range("A3") = "=MAX(A4:A50000)+1"

et j'ai ajouter cette ligne

Code:

Range("A3").Formula = "=FACTURE!E8"

et modifier c'elle la
Code:

1 2 3 Private Sub Workbook_SheetActivate(ByVal Sh As Object) If Sh.Name = "Facture" Then Range("E8").FormulaR1C1 = "=IF(ARCHIVESBDC!R3C1="""",""Fac-001-""&UPPER(TEXT(R[-2]C,""MMM"")),""Fac-""&TEXT(MID(ARCHIVESBDC!R[-5]C[-4],5,3)+1,""000"")&""-""&UPPER(TEXT(R[-2]C,""MMM"")))" End Sub
par celle la
Code:

1 2 3 4 5 6 Private Sub Workbook_SheetActivate(ByVal Sh As Object) If Sh.Name = "FACTURE" Then Range("E8").Select Range("E8").Formula = "=""Fac-""&TEXT(MID(ARCHIVESBDC!A3,5,3)+1,""000"")&"" ""&UPPER(TEXT(E6,""MMM""))" End If End Sub
et ça marche très bien

merci encore une fois Mr ARTURO83