Incrémenter un code alphanumérique automatique

[Calvus]

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

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

Private Sub UserForm_Initialize()

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

End Sub

Merci

 

[DoubleZero]

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

Bonjour, Calvus , le Forum,

En attendant une solution par macro... une possibilité grâce au format personnalisé :

A bientôt

P. S. : Gros zibous, Modeste

 

[Modeste]

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

Salut Calvus
Bise à 00

Pas certain de bien comprendre les tenants et aboutissants, alors à tout hasard:

Private Sub UserForm_Initialize()
With Feuil1
For Each nbr In .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
    On Error Resume Next
    If (Mid(nbr, 3, 9) * 1) > maxi Then maxi = Val(Mid(nbr, 3, 9))
Next nbr
TextBox1 = "CL" & maxi + 1
.Cells(Rows.Count, 1).End(xlUp)(2) = "CL" & maxi + 1
End With
End Sub

 

[Zdz16]

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

Bonjour à Tous et au forum;

En voila un autre sans Userform et paramétrable.

Cordialement

 

[job75]

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

Bonjour Calvus, DoubleZero, Modeste, Zdz16,

Pas besoin de TextBox1_Change :

Private Sub UserForm_Initialize()
With Feuil1.[A65536].End(xlUp)
  If .Row = 1 Then
    .Cells(2) = "CL1" 'initialisation
  Else
    .Cells.AutoFill .Cells.Resize(2) 'incrémentation
  End If
  TextBox1 = .Cells(2)
End With
End Sub

Pour commencer effacer toute la colonne A.

Bonne journée.

 

[job75]

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

Re,

Autre solution au cas où un petit malin tripoterait la colonne A :

Private Sub UserForm_Initialize()
With Feuil1.Range("A2", Feuil1.[A65536].End(xlUp)(2))
  .Cells(1) = "CL1"
  If .Count > 1 Then .Cells(1).AutoFill .Cells
  TextBox1 = .Cells(.Count)
End With
End Sub

A+

 

[Calvus]

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

Bonjour Double Zéro , Modeste , Zdz16, Job75 , le Forum,

Merci pour vos réponses qui fonctionnent toutes. Je n'ai que l'embarras du choix maintenant.

00, t'as toujours une astuce dans la poche finalement !

Modeste, que ne comprendrais tu pas dans ma demande ?
Peux tu expliquer ton code ?
Je vais demander la même chose à Job mais je sais qu'il ne le fera pas, je crois qu'il n'aime pas vraiment...., hein Job ?

Zdz16, j'ai besoin d'un formulaire, merci de cette proposition intéressante.

Job, si tu n'en n'as pas, je peux te proposer un boulot !

Merci et à bientôt.

 

[job75]

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

Re,

Comme le dit Zdz16 on peut se passer d'UserForm, voyez le fichier joint et cette macro :

Private Sub Worksheet_Change(ByVal Target As Range)
If ListObjects.Count = 0 Then Exit Sub
With ListObjects(1).DataBodyRange.Columns(1).Cells
  Application.EnableEvents = False
  .Cells(1) = "CL0"
  If .Count > 1 Then .Cells(1).AutoFill .Cells
  Application.EnableEvents = True
End With
End Sub

A+

 

[Zdz16]

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

Re;

Merci Job75 pour ton code. Cela m'a permis de découvrir la collection ListObjects que je ne connais pas.

Cordialement

 

[Calvus]

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

Bonjour à tous,

Je reviens avec la 1ère solution de Job75, qui a été intégrée à mon fichier.

Or l'ajout est systématique, ce que je voulais, seulement, je ne peux pas l'interrompre.
J'aimerais que la validation ne se fasse qu'une fois le bouton Ajouter du Userform ait été cliqué.

J'ai tenté d'ajouter une condition If, mais ça ne fonctionne pas, et ça a l'air d'être assez complexe, d'après ce que j'n ai lu.

Je l'ai tout de même laissée en commentaire dans le code

Private Sub UserForm_Initialize()
With Feuil1.[A65536].End(xlUp)
'If CallByName = CommandButton2_Click Then
'Exit Sub
'End If
  If .Row = 1 Then
    .Cells(2) = "CL1" 'initialisation
  Else
    .Cells.AutoFill .Cells.Resize(2) 'incrémentation
  End If
  TextBox1 = .Cells(2)
End With
End Sub

Voir le fichier joint pour le reste.

Merci

 

[job75]

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

Bonjour Calvus, le fil,

Avec le tableau organisé en Tableau Excel c'est cent fois mieux :

Private Sub UserForm_Initialize()
With Feuil1.ListObjects(1).Range
  .Sort .Cells(1), xlAscending, Header:=xlYes 'tri sur la 1ère colonne
  .Cells(2, 1) = "CL0001"
  If .Rows.Count > 2 Then .Cells(2, 1).AutoFill .Cells(2, 1).Resize(.Rows.Count - 1)
  TextBox1 = "CL" & Format(.Rows.Count, "0000")
End With
End Sub

Private Sub CommandButton1_Click()  ' AJOUTER
If Société = "" Then Société.SetFocus: Exit Sub
With Feuil1.ListObjects(1).DataBodyRange
  With .Rows(.Rows.Count + 1)
    .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 = ""
  End With
End With
Société.SetFocus
UserForm_Initialize
End Sub

Fichier joint.

A+

 

[job75]

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

Re,

Si l'on veut éviter d'entrer un doublon :

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)
    .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 = ""
  End With
End With
Société.SetFocus
UserForm_Initialize
End Sub

Fichier (2).

A+

 

[Calvus]

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

Bonsoir Job75, le fil,

Merci Job75. Mais 2 problèmes se posent.

Le 1er, c'est qu'après 2 heures de recherche sur le net, je n'arrive toujours pas à comprendre le fonctionnement du code, et donc n'arrive pas à le modifier ou l'adapter à mon fichier original. Quelques explications, si possible, seraient donc les bienvenues.

Le 2nd est que si je supprime une ligne, le compte reprend en comptant les lignes du tableau.
Or, je peux avoir besoin de supprimer un client, mais ai besoin de conserver un numéro unique.

Merci

 

[job75]

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

Re,

Le 2nd est que si je supprime une ligne, le compte reprend en comptant les lignes du tableau.
Or, je peux avoir besoin de supprimer un client, mais ai besoin de conserver un numéro unique.

Je vous comprends mais là on entre dans des choses compliquées.

Et sûrement inaccessibles pour vous puisque vous ne comprenez pas les codes très simples que j'ai donnés.

Bonne nuit.

 

[Calvus]

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

Cher Job,

C'est en effet compliqué pour moi car je n'ai pas vos connaissances.

C'est pourquoi d'ailleurs je demande de l'aide sur ce forum.
C'est pourquoi également je demande une explication sur les codes, mais il s'avère que c'est une denrée difficile à obtenir..

C'est pourquoi également je procède par étapes, essayant de comprendre.

Beaucoup ici demandent souvent des réponses toutes faites, ce qui n'est pas mon cas. Evidemment, je peux parfois faire parti de ceux-ci, car c'est un grand gain de temps quand on travaille sur un fichier, mais j'essaie surtout de progresser, par plaisir, et par volonté d'autonomie. Mais j'avoue baisser les bras quand je me trouve devant un code dont je n'arrive pas à comprendre le sens, et alors appliquer bêtement la solution apportée. Mais ce n'est que reculer pour mieux sauter.

Je vous comprends mais là on entre dans des choses compliquées.

Le 1er code envoyé fonctionnait non ? A part le fait d'écrire un numéro de client malgré tout.
Je pensais, certainement naïvement que l'on pourrait améliorer une ligne ou deux, sans tout devoir changer.

Et sûrement inaccessibles pour vous puisque vous ne comprenez pas les codes très simples que j'ai donnés.

Encore une fois, c'est simple pour vous.
Dois-je comprendre qu'il me faille m'arrêter là ?

Ou y a t'il une solution malgré tout ?

Bonne nuit