Incrémenter un code alphanumérique automatique

Calvus · 5 Janvier 2016

Bonsoir le forum,

Je cherche à incrémenter un code client automatique dans un textbox.

J'ai réussi en cherchant sur le forum et sur le net à réaliser une incrémentation automatique, mais uniquement numérique.
J'aimerais que ce soit alphanumérique. Ça semble difficile.
J'ai essayé "CL"&Val(TextBox1) mais ça fige la donnée.

Voici les codes que j'ai inscrtis

Code:

Private Sub TextBox1_Change()
Dim derligne As Integer
derligne = Range("A65536").End(xlUp).Row + 1
Feuil1.Cells(derligne, 1) = Val(TextBox1)
End Sub

Code:

Private Sub UserForm_Initialize()

TextBox1 = WorksheetFunction.Max(Feuil1.Range("A2:A1000")) + 1

End Sub

Merci

job75 · 10 Janvier 2016

Re : In crémenter un code alphanumérique automatique

Re,

Bon avant d'aller faire dodo voyez ce fichier (3).

1) Le format personnalisé en colonne A : "CL"0

2) Le code de la feuille :

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
'---autorise la suppression d'une ligne entière---
If Target.Columns.Count = Columns.Count Then Exit Sub
'---empêche la modification manuelle de la 1ère colonne du tableau---
Application.EnableEvents = False 'désactive les évènements
If Not Intersect(Target, Feuil1.ListObjects(1).DataBodyRange.Columns(1)) _
  Is Nothing Then Application.Undo
Application.EnableEvents = True 'réactive les évènements
End Sub

3) Le code de l'USF :

Code:

Private Sub UserForm_Initialize()
TextBox1 = "CL" & Application.Max(Feuil1.ListObjects(1).DataBodyRange.Columns(1)) + 1
End Sub

Private Sub CommandButton1_Click()  ' AJOUTER
If Société = "" Then Société.SetFocus: Exit Sub
With Feuil1.ListObjects(1).DataBodyRange
  If IsNumeric(Application.Match(Société, .Columns(2), 0)) Then
    Société.SetFocus
    Société.SelStart = 0
    Société.SelLength = Len(Société)
    MsgBox "Cette société existe déjà..."
    Exit Sub
  End If
  With .Rows(.Rows.Count + 1)
    Application.EnableEvents = False 'désactive les évènements
    .Cells(1) = Replace(TextBox1, "CL", "") 'TextBox1 doit être verrouillée
    .Cells(1, 2) = Société: Société = ""
    .Cells(1, 3) = Nom: Nom = ""
    .Cells(1, 4) = Prenom: Prenom = ""
    .Cells(1, 5) = Fonction: Fonction = ""
    .Cells(1, 6) = Adresse: Adresse = ""
    .Cells(1, 7) = CP: CP = ""
    .Cells(1, 8) = VILLE: VILLE = ""
    .Cells(1, 9) = TelFixe: TelFixe = ""
    .Cells(1, 10) = TelPort: TelPort = ""
    .Cells(1, 11) = Mail: Mail = ""
    .Cells(1, 12) = MSN: MSN = ""
    Application.EnableEvents = True 'réactive les évènements
  End With
End With
Société.SetFocus
UserForm_Initialize
End Sub

J'ai bien dit : TextBox1 doit être verrouillée (propriété Locked).

Ici un tri n'est pas nécessaire.

Re-bonne nuit.

Calvus · 10 Janvier 2016

Re : In crémenter un code alphanumérique automatique

Re,

Merci beaucoup Job75, ça fonctionne très bien maintenant.
Merci pour les commentaires également.

Une petite remarque, je pense qu'il doit être possible d'avoir plusieurs fois la même société. Plusieurs contacts dans la même société.
Je vais voir si je peux modifier dans ce sens, mais ce n'est pas très grave.
Surtout je vais étudier de près votre proposition pour évoluer.

Merci et bonne nuit.

job75 · 10 Janvier 2016

Re : In crémenter un code alphanumérique automatique

Bonjour Calvus, le forum,

Calvus à dit:
Une petite remarque, je pense qu'il doit être possible d'avoir plusieurs fois la même société. Plusieurs contacts dans la même société.

On peut ne pas traiter les doublons.

On peut aussi les traiter sur les 2 critères Nom & Prenom :

Code:

'---
  If IsNumeric(Application.Match(Nom & Prenom, Evaluate(.Columns(3).Address _
    & "&" & .Columns(4).Address), 0)) Then If _
    MsgBox("Nom et prénom existent déjà, voulez-vous continuer ?", 4, "Doublon") = 7 _
    Then Nom = "": Prenom = "": Nom.SetFocus: Exit Sub

Edit : on pourrait utiliser 3 critères mais je pense que 2 c'est mieux.

Fichier (4).

A+

Calvus · 10 Janvier 2016

Re : In crémenter un code alphanumérique automatique

Bonsoir Job75 , le forum,

Magnifique. Ça c'est du fichier !! Merci.

Pour la compréhension ce n'est pas encore tout à fait ça, mais j'y travaille..

Il reste une dernière chose. Si on part d'un fichier vierge, ou qu'on supprime les 4 1ères lignes de l'exemple, ça bug.
Avez vous une idée. Pas grave si vous ne trouvez pas. Il suffit de créer la 1ère ligne manuellement, et ça fonctionne ensuite.

Bonne soirée.

job75 · 10 Janvier 2016

Re : In crémenter un code alphanumérique automatique

Calvus à dit:
Il reste une dernière chose. Si on part d'un fichier vierge, ou qu'on supprime les 4 1ères lignes de l'exemple, ça bug.

Il faut bien sûr que le tableau Excel existe...

Donc insérer une ligne (ligne 3) sous celle des titres et la masquer.

Fichier (5).

A+

Si... · 13 Janvier 2016

Re : In crémenter un code alphanumérique automatique

salut

job75 à dit:
Il faut bien sûr que le tableau Excel existe...

Oh que oui !

Calvus, tu as dû déjà lire, voir, que l’utilisation de l’outil Tableau permettait de s’affranchir de bien des choses (de références d’emplacement, de report de formules, de formats …).

Voici un exemple (très facile à adapter pour les gestions de ce genre) de ce que j’utilise, notamment pour gérer mes comptes bancaires -même dans mes paradis fiscaux - d’autant plus que je n’ai pas 50 000 000 de lignes d’opération).

Calvus · 13 Janvier 2016

Re : In crémenter un code alphanumérique automatique

Bonsoir,

Merci Joseph ! Il a l'air très intéressant ton fichier.
Je n'ai pas encore tout compris sur le fonctionnement, et encore moins le code. Mais là, je ne vais même pas chercher...
Je regarderai tout ça en détail dès que mon emploi du temps me le permettra.

gérer mes comptes bancaires -même dans mes paradis fiscaux - d’autant plus que je n’ai pas 50 000 000 de lignes d’opération).

Faut dire qu'une opération de 50 000 000 peut suffire...

Merci, bonne soirée

Incrémenter un code alphanumérique automatique

Calvus

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Calvus

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Calvus

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Si...

XLDnaute Barbatruc

Pièces jointes

Calvus

XLDnaute Barbatruc

Discussions similaires