VBA - Numérotation auto pour format personnalisé

[celoburn]

Bonjour,

J'ai fait des recherches sur le forum mais je n'ai pas trouvé de solutions satisfaisantes (ou alors je n'ai pas réussi à les implémenter :/. Donc un petit coup de cerveau est le bienvenu !

Je voudrai afficher dans un Userform une numérotation automatique, que ce soit dans un Textbox, ou dans un Label (vu sur le forum).

sous le format 'NuméroMoisAnnée' où
'Numéro' va de 1 à l'infini
'Mois' de type mm
'Année' de type yy pour 2010,
Soit Nmmyy, au final pour la 1ere pièce du mois de janvier de l'année 2010 on a "11010"

Sous excel cela prendrait cette forme =CONCATENER(Numéro;MOIS(A3);ANNEE(A3))

En l'espèce dans le fichier il faut :
1. mettre une variable qui prend les valeurs, 1,2,3,4 etc....(suivant ce qui est déjà utilisé...et il faut que la variable recommence à partir de '1' si le mois change)
2. Récupérer le mois tapé dans la textbox nommée "DateBox"
3. Récupérer l'année mais juste les 2 derniers chiffres à partir de DateBox
4. Concaténer le tout

Si on peut afficher le numéro dès que l'utilisateur a tapé la date c'est encore mieux ! (mais facultatif )

Exemples de numéros :

11010
21010
31010
11110
21110
31110
11210
21210
ETC....

Je joins le fichier de travail, vous verrez pour ce qui s'y connaissent à mon avis le code c'est n'importe quoi puisque j'assemble des codes vba trouvés ci et là . Mais bon là j'ai pas l'ingrédient pour faire la soupe de code alors ... ..merci d'avance ! (et ça marche ..pour l'instant !)

erf..le fichier dépasse le maximum....ha non c'est bon ....

 

[youky(BJ)]

Re : VBA - Numérotation auto pour format personnalisé

Bonsoir celoburn,
A rajouter ce qui est en rouge dans ta macro Exit du textbox
Bruno

Private Sub DateBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    
    If Len(DateBox.Text) = 0 Then
        GoTo Fin
    End If
        
    If Len(Replace(DateBox.Text, "/", "")) <> 6 And Len(Replace(DateBox.Text, "/", "")) <> 8 Then
        GoTo ErreurSaisie
    End If
    
    If Len(DateBox.Text) = 6 Then
        If Right(DateBox, 2) > 50 Then
            DateBox = Left(DateBox, 4) & 19 & Right(DateBox, 2)
        Else
            DateBox = Left(DateBox, 4) & 20 & Right(DateBox, 2)
        End If
    End If
    
    DateBox.Text = Left(Replace(DateBox.Text, "/", ""), 2) & "/" & Mid(Replace(DateBox.Text, "/", ""), 3, 2) & "/" & Right(Replace(DateBox.Text, "/", ""), 4)
    DateBox.MaxLength = 10
    
    If Not IsDate(DateBox.Value) Then
        GoTo ErreurSaisie
    End If

[COLOR="red"]
aa = Format(Month(DateBox), "00") & Right(Year(DateBox), 2)
If Right(Feuil1.[J65536].End(3), 4) = aa Then
LabelNo = Feuil1.[J65536].End(3) + 1
Else
LabelNo = "01" & aa
End If
[/COLOR]    
GoTo Fin
    
ErreurSaisie:

    Cancel = True
    With DateBox
        .BackColor = &HFF&
        MsgBox "Date saisie incorrecte"
        DateBox.Text = Replace(DateBox.Text, "/", "")
        .SetFocus
        .SelStart = 0
        .SelLength = Len(DateBox.Text)
    End With

Fin:

End Sub

ATTENTION le rouge n'est pas passé ne pas copier les 2 lignes qui on les crochets

 

[celoburn]

Re : VBA - Numérotation auto pour format personnalisé

Merci Bruno pour ta réponse.
Le format est bon, et en prime je comprend comment tu y arrive (plus ou moins quelque zone d'ombre notamment sur "End(3)")...par contre la numérotation ne change pas.
Ex : 1ère pièce de Janvier = 010110 OK
2ème pièce de Janvier = 010110 devrait être 020110
3ème pièce de Janvier = 010110 devrait être 030110
1ère pièce de février = 010210 OK
2ème pièce de février = 010210 devrait être 020210

En fait il faut incrémenter en fonction de aa = Format(Month(DateBox), "00") & Right(Year(DateBox), 2) je pense...

Merci

code actuel

aa = Format(Month(DateBox), "00") & Right(Year(DateBox), 2)
If Right(Feuil1.[J65536].End(3), 4) = aa Then
LabelNo = Feuil1.[J65536].End(3) + 1
Else
LabelNo = "01" & aa
End If

 

[youky(BJ)]

Re : VBA - Numérotation auto pour format personnalisé

Hé oui petite boulette,
Bon je pense que cette fois ca va coller

aa = Format(Month(DateBox), "00") & Right(Year(DateBox), 2)
If Right(Feuil1.[j65536].End(3), 4) = aa Then
LabelNo = Replace(Feuil1.[j65536].End(3), aa, "") + 1 & aa
Else
LabelNo = "01" & aa
End If

Pour le End(3) le 3=(xlup)
Feuil1.[j65536].End(3) renvoie la valeur de la derniere cellule de col J
Je préfère utiliser Feuil1 qui est le codename de l'onglet et non le .name de l'onglet que l'on peux facilement renommé sans bug.
Dans l'éditeur en fenetre projet VBA tu verras Feuil1(Données)
Bruno