mais pourquoi tu me fais un tirage aléatoire au lieu d'une incrémentation
"toute bête" (+1 à chaque fois, sauf aux sauts de pas spécifiés) ? Tu veux
vérifier si je suis ?... :-))
mais pourquoi tu me fais un tirage aléatoire au lieu d'une incrémentation
"toute bête" (+1 à chaque fois, sauf aux sauts de pas spécifiés) ? Tu veux
vérifier si je suis ?... :-))
mais pourquoi tu me fais un tirage aléatoire au lieu d'une incrémentation
"toute bête" (+1 à chaque fois, sauf aux sauts de pas spécifiés) ? Tu veux
vérifier si je suis ?... :-))
Bonjour Michel
Je te transmet une reponse de Denis sur Answers,
Debut copie
'------------------
(Comme la communication est impossible sur aioe.org
J'espère que quelqu'un aura la générosité de lui transmettre...
2 Procédures :
Incrémenter toute la colonne A
La dernière lettre K a été omise, faute d'information adéquate.
Adapter le nom de la feuille si besoin...
'-------------------------------------
Sub Incrémentation_Sur_Toute_La_Colonne()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long, ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Feuil1")
'Valeur de la première cellule
.Range("A1") = "AA-1001"
'Dernière ligne de la feuille -1
DerLig = .Range("A:A").Rows.Count - 1
'Boucle sur chaque ligne de la feuille
For Each C In .Range("A1:A" & DerLig)
T = Split(C.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
C.Offset(1) = R
Next
End With
Application.EnableEvents = True
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
End Sub
'-------------------------------------
Une cellule à la fois, la ligne 1 est présumée être l'étiquette de colonne
'-------------------------------------
Sub Incrémentation_Une_Ligne_à_La_Fois()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long
With Worksheets("Feuil1")
With .Range("A" & .Range("A" & .Cells.Rows.Count).End(xlUp).Row)
If .Address = "$A$1" Then
If .Offset(1).Value = "" Then
.Offset(1).Value = "AA-1001"
Exit Sub
End If
Else
T = Split(.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
.Offset(1).Value = R
End If
End With
End With
End Sub
--------------------------------------------------------------------------------
MichD
'-------------Fin copie----------------
--
Salutations
JJ
"Péhemme" a écrit dans le message de news:
4c65cc28$0$10196$Bonjour(soir) à Tous,
J'ai un problème d'incrémentation alphabétique tordue.
J'ai une base de données qui s'alimente via des TextBox et Label placés
sur un UserForm.
Au moment de la saisie, un Label doit être rempli automatiquement en
allant chercher dans la BdD le n° précédent incrémenté de 1.
1°) Première partie à incrémenter (déjà tordue) : la série :
La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait
a) numériquement de 1001 à 9999
b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001 à
ZZ-9999)
Si cela peut aider, on peut supprimer le tiret utilisé comme séparateur.
Sa présence a pour but d'obtenir une lecture plus facile du n° complet.
2°) Seconde partie : la lettre finale :
Elle doit s'incrémenter de K (plus petit caractère) à Z (le plus grand).
Cette incrémentation, bien que liée au n° de série, est indépendante de
celui-ci (une série quelconque peut, à titre d'exemple, ne posséder que 3
lettres finales distinctes (K, L ou M par exemple). Mais au minimum un
seul élément dans la série : K.
Le plus petit n° complet s'écrit donc AA-1001-K
Je n'ai pas encore traité ce dernier point, mais je me débrouillerai.
Ne sachant pas comment faire, j'ai solutionné le problème du n° de série
:
a) en créant 4 colonnes dans ma BdD et 4 Label (dont 3 invisibles) sur
mon UserForm
b) en écrivant la macro suivante qui répond à mon problème mais qui me
semble « contorsionniste et bourrin ».
L'un d'entre vous sait-il si je peux, et dans la série « j'ai la plus
courte », incrémenter directement mes séries sans passer par la
dichotomie de son n°.
Merci d'avance de vos avis et commentaires.
La macro :
Private Sub UserForm_Initialize()
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim R As Long
If R = 65535 Then
MsgBox "Vous êtes à la fin de la page !"
GoTo Fin
Else
R = Sheets("Feuil1").Range("G65536").End(xlUp).Row
End If
'Une première ligne est déjà remplie à A, A, 1000 pour rentrer dans la
boucle
x = Range("G" & R).Value + 1
y = Asc(Range("Feuil1!F65536").End(xlUp).Value)
z = Asc(Range("Feuil1!E65536").End(xlUp).Value)
If x = 10000 Then
x = 1001
y = y + 1
If y = 91 Then
y = 65
z = z + 1
If z = 91 Then
GoTo Fin
End If
End If
End If
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
Label1 = Chr(z)
Label2 = Chr(y)
Label3 = x
Label4 = Label1 & Label2 & "-" & Label3
Exit Sub
Fin:
MsgBox "Vous êtes au maximum autorisé", vbCritical, "ATTENTION LIMITES
!"
End Sub
Bonne nuit
Michel
Bonjour Michel
Je te transmet une reponse de Denis sur Answers,
Debut copie
'------------------
(Comme la communication est impossible sur aioe.org
J'espère que quelqu'un aura la générosité de lui transmettre...
2 Procédures :
Incrémenter toute la colonne A
La dernière lettre K a été omise, faute d'information adéquate.
Adapter le nom de la feuille si besoin...
'-------------------------------------
Sub Incrémentation_Sur_Toute_La_Colonne()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long, ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Feuil1")
'Valeur de la première cellule
.Range("A1") = "AA-1001"
'Dernière ligne de la feuille -1
DerLig = .Range("A:A").Rows.Count - 1
'Boucle sur chaque ligne de la feuille
For Each C In .Range("A1:A" & DerLig)
T = Split(C.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
C.Offset(1) = R
Next
End With
Application.EnableEvents = True
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
End Sub
'-------------------------------------
Une cellule à la fois, la ligne 1 est présumée être l'étiquette de colonne
'-------------------------------------
Sub Incrémentation_Une_Ligne_à_La_Fois()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long
With Worksheets("Feuil1")
With .Range("A" & .Range("A" & .Cells.Rows.Count).End(xlUp).Row)
If .Address = "$A$1" Then
If .Offset(1).Value = "" Then
.Offset(1).Value = "AA-1001"
Exit Sub
End If
Else
T = Split(.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
.Offset(1).Value = R
End If
End With
End With
End Sub
--------------------------------------------------------------------------------
MichD
'-------------Fin copie----------------
--
Salutations
JJ
"Péhemme" <xx@xx.xx> a écrit dans le message de news:
4c65cc28$0$10196$ba4acef3@reader.news.orange.fr...
Bonjour(soir) à Tous,
J'ai un problème d'incrémentation alphabétique tordue.
J'ai une base de données qui s'alimente via des TextBox et Label placés
sur un UserForm.
Au moment de la saisie, un Label doit être rempli automatiquement en
allant chercher dans la BdD le n° précédent incrémenté de 1.
1°) Première partie à incrémenter (déjà tordue) : la série :
La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait
a) numériquement de 1001 à 9999
b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001 à
ZZ-9999)
Si cela peut aider, on peut supprimer le tiret utilisé comme séparateur.
Sa présence a pour but d'obtenir une lecture plus facile du n° complet.
2°) Seconde partie : la lettre finale :
Elle doit s'incrémenter de K (plus petit caractère) à Z (le plus grand).
Cette incrémentation, bien que liée au n° de série, est indépendante de
celui-ci (une série quelconque peut, à titre d'exemple, ne posséder que 3
lettres finales distinctes (K, L ou M par exemple). Mais au minimum un
seul élément dans la série : K.
Le plus petit n° complet s'écrit donc AA-1001-K
Je n'ai pas encore traité ce dernier point, mais je me débrouillerai.
Ne sachant pas comment faire, j'ai solutionné le problème du n° de série
:
a) en créant 4 colonnes dans ma BdD et 4 Label (dont 3 invisibles) sur
mon UserForm
b) en écrivant la macro suivante qui répond à mon problème mais qui me
semble « contorsionniste et bourrin ».
L'un d'entre vous sait-il si je peux, et dans la série « j'ai la plus
courte », incrémenter directement mes séries sans passer par la
dichotomie de son n°.
Merci d'avance de vos avis et commentaires.
La macro :
Private Sub UserForm_Initialize()
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim R As Long
If R = 65535 Then
MsgBox "Vous êtes à la fin de la page !"
GoTo Fin
Else
R = Sheets("Feuil1").Range("G65536").End(xlUp).Row
End If
'Une première ligne est déjà remplie à A, A, 1000 pour rentrer dans la
boucle
x = Range("G" & R).Value + 1
y = Asc(Range("Feuil1!F65536").End(xlUp).Value)
z = Asc(Range("Feuil1!E65536").End(xlUp).Value)
If x = 10000 Then
x = 1001
y = y + 1
If y = 91 Then
y = 65
z = z + 1
If z = 91 Then
GoTo Fin
End If
End If
End If
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
Label1 = Chr(z)
Label2 = Chr(y)
Label3 = x
Label4 = Label1 & Label2 & "-" & Label3
Exit Sub
Fin:
MsgBox "Vous êtes au maximum autorisé", vbCritical, "ATTENTION LIMITES
!"
End Sub
Bonne nuit
Michel
Bonjour Michel
Je te transmet une reponse de Denis sur Answers,
Debut copie
'------------------
(Comme la communication est impossible sur aioe.org
J'espère que quelqu'un aura la générosité de lui transmettre...
2 Procédures :
Incrémenter toute la colonne A
La dernière lettre K a été omise, faute d'information adéquate.
Adapter le nom de la feuille si besoin...
'-------------------------------------
Sub Incrémentation_Sur_Toute_La_Colonne()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long, ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Feuil1")
'Valeur de la première cellule
.Range("A1") = "AA-1001"
'Dernière ligne de la feuille -1
DerLig = .Range("A:A").Rows.Count - 1
'Boucle sur chaque ligne de la feuille
For Each C In .Range("A1:A" & DerLig)
T = Split(C.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
C.Offset(1) = R
Next
End With
Application.EnableEvents = True
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
End Sub
'-------------------------------------
Une cellule à la fois, la ligne 1 est présumée être l'étiquette de colonne
'-------------------------------------
Sub Incrémentation_Une_Ligne_à_La_Fois()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long
With Worksheets("Feuil1")
With .Range("A" & .Range("A" & .Cells.Rows.Count).End(xlUp).Row)
If .Address = "$A$1" Then
If .Offset(1).Value = "" Then
.Offset(1).Value = "AA-1001"
Exit Sub
End If
Else
T = Split(.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
.Offset(1).Value = R
End If
End With
End With
End Sub
--------------------------------------------------------------------------------
MichD
'-------------Fin copie----------------
--
Salutations
JJ
"Péhemme" a écrit dans le message de news:
4c65cc28$0$10196$Bonjour(soir) à Tous,
J'ai un problème d'incrémentation alphabétique tordue.
J'ai une base de données qui s'alimente via des TextBox et Label placés
sur un UserForm.
Au moment de la saisie, un Label doit être rempli automatiquement en
allant chercher dans la BdD le n° précédent incrémenté de 1.
1°) Première partie à incrémenter (déjà tordue) : la série :
La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait
a) numériquement de 1001 à 9999
b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001 à
ZZ-9999)
Si cela peut aider, on peut supprimer le tiret utilisé comme séparateur.
Sa présence a pour but d'obtenir une lecture plus facile du n° complet.
2°) Seconde partie : la lettre finale :
Elle doit s'incrémenter de K (plus petit caractère) à Z (le plus grand).
Cette incrémentation, bien que liée au n° de série, est indépendante de
celui-ci (une série quelconque peut, à titre d'exemple, ne posséder que 3
lettres finales distinctes (K, L ou M par exemple). Mais au minimum un
seul élément dans la série : K.
Le plus petit n° complet s'écrit donc AA-1001-K
Je n'ai pas encore traité ce dernier point, mais je me débrouillerai.
Ne sachant pas comment faire, j'ai solutionné le problème du n° de série
:
a) en créant 4 colonnes dans ma BdD et 4 Label (dont 3 invisibles) sur
mon UserForm
b) en écrivant la macro suivante qui répond à mon problème mais qui me
semble « contorsionniste et bourrin ».
L'un d'entre vous sait-il si je peux, et dans la série « j'ai la plus
courte », incrémenter directement mes séries sans passer par la
dichotomie de son n°.
Merci d'avance de vos avis et commentaires.
La macro :
Private Sub UserForm_Initialize()
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim R As Long
If R = 65535 Then
MsgBox "Vous êtes à la fin de la page !"
GoTo Fin
Else
R = Sheets("Feuil1").Range("G65536").End(xlUp).Row
End If
'Une première ligne est déjà remplie à A, A, 1000 pour rentrer dans la
boucle
x = Range("G" & R).Value + 1
y = Asc(Range("Feuil1!F65536").End(xlUp).Value)
z = Asc(Range("Feuil1!E65536").End(xlUp).Value)
If x = 10000 Then
x = 1001
y = y + 1
If y = 91 Then
y = 65
z = z + 1
If z = 91 Then
GoTo Fin
End If
End If
End If
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
Label1 = Chr(z)
Label2 = Chr(y)
Label3 = x
Label4 = Label1 & Label2 & "-" & Label3
Exit Sub
Fin:
MsgBox "Vous êtes au maximum autorisé", vbCritical, "ATTENTION LIMITES
!"
End Sub
Bonne nuit
Michel
Tu peux dire à Denis :
Bonjour Jacky
Merci à toi de jouer les transmetteurs.
Il faudra bien qu'un jour j'installe ce fameux bridge...
Tu peux dire à Denis :
"Ta macro (au cas par cas) fonctionne parfaitement bien.
Je l'ai juste adaptée à mes besoins.
Je suis effectivement un peu faiblard dans l'utilisation des fonctions de chaîne (s'il n'y avait que là...).
J'ai là matière à les travailler.
Ah, au fait, Merci !
:-))
Michel"
Merci à toi aussi Jacky
Michel
"Jacky" a écrit dans le message de news:4c667ec4$0$5400$Bonjour Michel
Je te transmet une reponse de Denis sur Answers,
Debut copie
'------------------
(Comme la communication est impossible sur aioe.org
J'espère que quelqu'un aura la générosité de lui transmettre...
2 Procédures :
Incrémenter toute la colonne A
La dernière lettre K a été omise, faute d'information adéquate.
Adapter le nom de la feuille si besoin...
'-------------------------------------
Sub Incrémentation_Sur_Toute_La_Colonne()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long, ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Feuil1")
'Valeur de la première cellule
.Range("A1") = "AA-1001"
'Dernière ligne de la feuille -1
DerLig = .Range("A:A").Rows.Count - 1
'Boucle sur chaque ligne de la feuille
For Each C In .Range("A1:A" & DerLig)
T = Split(C.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
C.Offset(1) = R
Next
End With
Application.EnableEvents = True
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
End Sub
'-------------------------------------
Une cellule à la fois, la ligne 1 est présumée être l'étiquette de colonne
'-------------------------------------
Sub Incrémentation_Une_Ligne_à_La_Fois()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long
With Worksheets("Feuil1")
With .Range("A" & .Range("A" & .Cells.Rows.Count).End(xlUp).Row)
If .Address = "$A$1" Then
If .Offset(1).Value = "" Then
.Offset(1).Value = "AA-1001"
Exit Sub
End If
Else
T = Split(.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
.Offset(1).Value = R
End If
End With
End With
End Sub
--------------------------------------------------------------------------------
MichD
'-------------Fin copie----------------
--
Salutations
JJ
"Péhemme" a écrit dans le message de news: 4c65cc28$0$10196$Bonjour(soir) à Tous,
J'ai un problème d'incrémentation alphabétique tordue.
J'ai une base de données qui s'alimente via des TextBox et Label placés sur un UserForm.
Au moment de la saisie, un Label doit être rempli automatiquement en allant chercher dans la BdD le n°
précédent incrémenté de 1.
1°) Première partie à incrémenter (déjà tordue) : la série :
La difficulté est que le n° de départ (plus petit n°) étant AA-1001, l'incrémentation se fait
a) numériquement de 1001 à 9999
b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de AB-9999 on passe à AC-1001 (la limite
théorique étant la série ZZ-1001 à ZZ-9999)
Si cela peut aider, on peut supprimer le tiret utilisé comme séparateur. Sa présence a pour but d'obtenir
une lecture plus facile du n° complet.
2°) Seconde partie : la lettre finale :
Elle doit s'incrémenter de K (plus petit caractère) à Z (le plus grand). Cette incrémentation, bien que
liée au n° de série, est indépendante de celui-ci (une série quelconque peut, à titre d'exemple, ne
posséder que 3 lettres finales distinctes (K, L ou M par exemple). Mais au minimum un seul élément dans la
série : K.
Le plus petit n° complet s'écrit donc AA-1001-K
Je n'ai pas encore traité ce dernier point, mais je me débrouillerai.
Ne sachant pas comment faire, j'ai solutionné le problème du n° de série :
a) en créant 4 colonnes dans ma BdD et 4 Label (dont 3 invisibles) sur mon UserForm
b) en écrivant la macro suivante qui répond à mon problème mais qui me semble « contorsionniste et
bourrin ».
L'un d'entre vous sait-il si je peux, et dans la série « j'ai la plus courte », incrémenter directement
mes séries sans passer par la dichotomie de son n°.
Merci d'avance de vos avis et commentaires.
La macro :
Private Sub UserForm_Initialize()
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim R As Long
If R = 65535 Then
MsgBox "Vous êtes à la fin de la page !"
GoTo Fin
Else
R = Sheets("Feuil1").Range("G65536").End(xlUp).Row
End If
'Une première ligne est déjà remplie à A, A, 1000 pour rentrer dans la boucle
x = Range("G" & R).Value + 1
y = Asc(Range("Feuil1!F65536").End(xlUp).Value)
z = Asc(Range("Feuil1!E65536").End(xlUp).Value)
If x = 10000 Then
x = 1001
y = y + 1
If y = 91 Then
y = 65
z = z + 1
If z = 91 Then
GoTo Fin
End If
End If
End If
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
Label1 = Chr(z)
Label2 = Chr(y)
Label3 = x
Label4 = Label1 & Label2 & "-" & Label3
Exit Sub
Fin:
MsgBox "Vous êtes au maximum autorisé", vbCritical, "ATTENTION LIMITES !"
End Sub
Bonne nuit
Michel
Tu peux dire à Denis :
Bonjour Jacky
Merci à toi de jouer les transmetteurs.
Il faudra bien qu'un jour j'installe ce fameux bridge...
Tu peux dire à Denis :
"Ta macro (au cas par cas) fonctionne parfaitement bien.
Je l'ai juste adaptée à mes besoins.
Je suis effectivement un peu faiblard dans l'utilisation des fonctions de chaîne (s'il n'y avait que là...).
J'ai là matière à les travailler.
Ah, au fait, Merci !
:-))
Michel"
Merci à toi aussi Jacky
Michel
"Jacky" <Dupond@marcel.fr> a écrit dans le message de news:4c667ec4$0$5400$ba4acef3@reader.news.orange.fr...
Bonjour Michel
Je te transmet une reponse de Denis sur Answers,
Debut copie
'------------------
(Comme la communication est impossible sur aioe.org
J'espère que quelqu'un aura la générosité de lui transmettre...
2 Procédures :
Incrémenter toute la colonne A
La dernière lettre K a été omise, faute d'information adéquate.
Adapter le nom de la feuille si besoin...
'-------------------------------------
Sub Incrémentation_Sur_Toute_La_Colonne()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long, ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Feuil1")
'Valeur de la première cellule
.Range("A1") = "AA-1001"
'Dernière ligne de la feuille -1
DerLig = .Range("A:A").Rows.Count - 1
'Boucle sur chaque ligne de la feuille
For Each C In .Range("A1:A" & DerLig)
T = Split(C.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
C.Offset(1) = R
Next
End With
Application.EnableEvents = True
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
End Sub
'-------------------------------------
Une cellule à la fois, la ligne 1 est présumée être l'étiquette de colonne
'-------------------------------------
Sub Incrémentation_Une_Ligne_à_La_Fois()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long
With Worksheets("Feuil1")
With .Range("A" & .Range("A" & .Cells.Rows.Count).End(xlUp).Row)
If .Address = "$A$1" Then
If .Offset(1).Value = "" Then
.Offset(1).Value = "AA-1001"
Exit Sub
End If
Else
T = Split(.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
.Offset(1).Value = R
End If
End With
End With
End Sub
--------------------------------------------------------------------------------
MichD
'-------------Fin copie----------------
--
Salutations
JJ
"Péhemme" <xx@xx.xx> a écrit dans le message de news: 4c65cc28$0$10196$ba4acef3@reader.news.orange.fr...
Bonjour(soir) à Tous,
J'ai un problème d'incrémentation alphabétique tordue.
J'ai une base de données qui s'alimente via des TextBox et Label placés sur un UserForm.
Au moment de la saisie, un Label doit être rempli automatiquement en allant chercher dans la BdD le n°
précédent incrémenté de 1.
1°) Première partie à incrémenter (déjà tordue) : la série :
La difficulté est que le n° de départ (plus petit n°) étant AA-1001, l'incrémentation se fait
a) numériquement de 1001 à 9999
b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de AB-9999 on passe à AC-1001 (la limite
théorique étant la série ZZ-1001 à ZZ-9999)
Si cela peut aider, on peut supprimer le tiret utilisé comme séparateur. Sa présence a pour but d'obtenir
une lecture plus facile du n° complet.
2°) Seconde partie : la lettre finale :
Elle doit s'incrémenter de K (plus petit caractère) à Z (le plus grand). Cette incrémentation, bien que
liée au n° de série, est indépendante de celui-ci (une série quelconque peut, à titre d'exemple, ne
posséder que 3 lettres finales distinctes (K, L ou M par exemple). Mais au minimum un seul élément dans la
série : K.
Le plus petit n° complet s'écrit donc AA-1001-K
Je n'ai pas encore traité ce dernier point, mais je me débrouillerai.
Ne sachant pas comment faire, j'ai solutionné le problème du n° de série :
a) en créant 4 colonnes dans ma BdD et 4 Label (dont 3 invisibles) sur mon UserForm
b) en écrivant la macro suivante qui répond à mon problème mais qui me semble « contorsionniste et
bourrin ».
L'un d'entre vous sait-il si je peux, et dans la série « j'ai la plus courte », incrémenter directement
mes séries sans passer par la dichotomie de son n°.
Merci d'avance de vos avis et commentaires.
La macro :
Private Sub UserForm_Initialize()
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim R As Long
If R = 65535 Then
MsgBox "Vous êtes à la fin de la page !"
GoTo Fin
Else
R = Sheets("Feuil1").Range("G65536").End(xlUp).Row
End If
'Une première ligne est déjà remplie à A, A, 1000 pour rentrer dans la boucle
x = Range("G" & R).Value + 1
y = Asc(Range("Feuil1!F65536").End(xlUp).Value)
z = Asc(Range("Feuil1!E65536").End(xlUp).Value)
If x = 10000 Then
x = 1001
y = y + 1
If y = 91 Then
y = 65
z = z + 1
If z = 91 Then
GoTo Fin
End If
End If
End If
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
Label1 = Chr(z)
Label2 = Chr(y)
Label3 = x
Label4 = Label1 & Label2 & "-" & Label3
Exit Sub
Fin:
MsgBox "Vous êtes au maximum autorisé", vbCritical, "ATTENTION LIMITES !"
End Sub
Bonne nuit
Michel
Tu peux dire à Denis :
Bonjour Jacky
Merci à toi de jouer les transmetteurs.
Il faudra bien qu'un jour j'installe ce fameux bridge...
Tu peux dire à Denis :
"Ta macro (au cas par cas) fonctionne parfaitement bien.
Je l'ai juste adaptée à mes besoins.
Je suis effectivement un peu faiblard dans l'utilisation des fonctions de chaîne (s'il n'y avait que là...).
J'ai là matière à les travailler.
Ah, au fait, Merci !
:-))
Michel"
Merci à toi aussi Jacky
Michel
"Jacky" a écrit dans le message de news:4c667ec4$0$5400$Bonjour Michel
Je te transmet une reponse de Denis sur Answers,
Debut copie
'------------------
(Comme la communication est impossible sur aioe.org
J'espère que quelqu'un aura la générosité de lui transmettre...
2 Procédures :
Incrémenter toute la colonne A
La dernière lettre K a été omise, faute d'information adéquate.
Adapter le nom de la feuille si besoin...
'-------------------------------------
Sub Incrémentation_Sur_Toute_La_Colonne()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long, ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Feuil1")
'Valeur de la première cellule
.Range("A1") = "AA-1001"
'Dernière ligne de la feuille -1
DerLig = .Range("A:A").Rows.Count - 1
'Boucle sur chaque ligne de la feuille
For Each C In .Range("A1:A" & DerLig)
T = Split(C.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
C.Offset(1) = R
Next
End With
Application.EnableEvents = True
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
End Sub
'-------------------------------------
Une cellule à la fois, la ligne 1 est présumée être l'étiquette de colonne
'-------------------------------------
Sub Incrémentation_Une_Ligne_à_La_Fois()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long
With Worksheets("Feuil1")
With .Range("A" & .Range("A" & .Cells.Rows.Count).End(xlUp).Row)
If .Address = "$A$1" Then
If .Offset(1).Value = "" Then
.Offset(1).Value = "AA-1001"
Exit Sub
End If
Else
T = Split(.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
.Offset(1).Value = R
End If
End With
End With
End Sub
--------------------------------------------------------------------------------
MichD
'-------------Fin copie----------------
--
Salutations
JJ
"Péhemme" a écrit dans le message de news: 4c65cc28$0$10196$Bonjour(soir) à Tous,
J'ai un problème d'incrémentation alphabétique tordue.
J'ai une base de données qui s'alimente via des TextBox et Label placés sur un UserForm.
Au moment de la saisie, un Label doit être rempli automatiquement en allant chercher dans la BdD le n°
précédent incrémenté de 1.
1°) Première partie à incrémenter (déjà tordue) : la série :
La difficulté est que le n° de départ (plus petit n°) étant AA-1001, l'incrémentation se fait
a) numériquement de 1001 à 9999
b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de AB-9999 on passe à AC-1001 (la limite
théorique étant la série ZZ-1001 à ZZ-9999)
Si cela peut aider, on peut supprimer le tiret utilisé comme séparateur. Sa présence a pour but d'obtenir
une lecture plus facile du n° complet.
2°) Seconde partie : la lettre finale :
Elle doit s'incrémenter de K (plus petit caractère) à Z (le plus grand). Cette incrémentation, bien que
liée au n° de série, est indépendante de celui-ci (une série quelconque peut, à titre d'exemple, ne
posséder que 3 lettres finales distinctes (K, L ou M par exemple). Mais au minimum un seul élément dans la
série : K.
Le plus petit n° complet s'écrit donc AA-1001-K
Je n'ai pas encore traité ce dernier point, mais je me débrouillerai.
Ne sachant pas comment faire, j'ai solutionné le problème du n° de série :
a) en créant 4 colonnes dans ma BdD et 4 Label (dont 3 invisibles) sur mon UserForm
b) en écrivant la macro suivante qui répond à mon problème mais qui me semble « contorsionniste et
bourrin ».
L'un d'entre vous sait-il si je peux, et dans la série « j'ai la plus courte », incrémenter directement
mes séries sans passer par la dichotomie de son n°.
Merci d'avance de vos avis et commentaires.
La macro :
Private Sub UserForm_Initialize()
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim R As Long
If R = 65535 Then
MsgBox "Vous êtes à la fin de la page !"
GoTo Fin
Else
R = Sheets("Feuil1").Range("G65536").End(xlUp).Row
End If
'Une première ligne est déjà remplie à A, A, 1000 pour rentrer dans la boucle
x = Range("G" & R).Value + 1
y = Asc(Range("Feuil1!F65536").End(xlUp).Value)
z = Asc(Range("Feuil1!E65536").End(xlUp).Value)
If x = 10000 Then
x = 1001
y = y + 1
If y = 91 Then
y = 65
z = z + 1
If z = 91 Then
GoTo Fin
End If
End If
End If
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
Label1 = Chr(z)
Label2 = Chr(y)
Label3 = x
Label4 = Label1 & Label2 & "-" & Label3
Exit Sub
Fin:
MsgBox "Vous êtes au maximum autorisé", vbCritical, "ATTENTION LIMITES !"
End Sub
Bonne nuit
Michel
S'il ne peut pas émettre sur aioe.org, il peut néanmoins lire les news.
Donc, pas besoin de lui transmettre ;o))
S'il ne peut pas émettre sur aioe.org, il peut néanmoins lire les news.
Donc, pas besoin de lui transmettre ;o))
S'il ne peut pas émettre sur aioe.org, il peut néanmoins lire les news.
Donc, pas besoin de lui transmettre ;o))
Bonsour® (réponse via news.aioe.org)
"Péhemme" a écritmais pourquoi tu me fais un tirage aléatoire au lieu d'une incrémentation
"toute bête" (+1 à chaque fois, sauf aux sauts de pas spécifiés) ? Tu
veux vérifier si je suis ?... :-))
;o))) le tirage aléatoire ne concerne que la procédure de test
la macro incremente ne fait son action qu'une seule fois mais à chaque
fois
quelle est exécutée
il serait alors trés simple de transformer cette macro en procédure et en
lui
passant l'adresse en parametre
function Increment(Lacellule as range) as string
X=Lacellule
........
./.
.......
Increment= Chr(alpha1) & Chr(alpha2) & "-" & Format(nombre, "0000")
End Function
utilisation :
B2=Increment(A1)
Bonsour® (réponse via news.aioe.org)
"Péhemme" <xx@xx.xx> a écrit
mais pourquoi tu me fais un tirage aléatoire au lieu d'une incrémentation
"toute bête" (+1 à chaque fois, sauf aux sauts de pas spécifiés) ? Tu
veux vérifier si je suis ?... :-))
;o))) le tirage aléatoire ne concerne que la procédure de test
la macro incremente ne fait son action qu'une seule fois mais à chaque
fois
quelle est exécutée
il serait alors trés simple de transformer cette macro en procédure et en
lui
passant l'adresse en parametre
function Increment(Lacellule as range) as string
X=Lacellule
........
./.
.......
Increment= Chr(alpha1) & Chr(alpha2) & "-" & Format(nombre, "0000")
End Function
utilisation :
B2=Increment(A1)
Bonsour® (réponse via news.aioe.org)
"Péhemme" a écritmais pourquoi tu me fais un tirage aléatoire au lieu d'une incrémentation
"toute bête" (+1 à chaque fois, sauf aux sauts de pas spécifiés) ? Tu
veux vérifier si je suis ?... :-))
;o))) le tirage aléatoire ne concerne que la procédure de test
la macro incremente ne fait son action qu'une seule fois mais à chaque
fois
quelle est exécutée
il serait alors trés simple de transformer cette macro en procédure et en
lui
passant l'adresse en parametre
function Increment(Lacellule as range) as string
X=Lacellule
........
./.
.......
Increment= Chr(alpha1) & Chr(alpha2) & "-" & Format(nombre, "0000")
End Function
utilisation :
B2=Increment(A1)
Re..Tu peux dire à Denis :
S'il ne peut pas émettre sur aioe.org, il peut néanmoins lire les news.
Donc, pas besoin de lui transmettre ;o))
--
Bon we
Jacky
"Péhemme" a écrit dans le message de news:
4c669cf7$0$5390$Bonjour Jacky
Merci à toi de jouer les transmetteurs.
Il faudra bien qu'un jour j'installe ce fameux bridge...
Tu peux dire à Denis :
"Ta macro (au cas par cas) fonctionne parfaitement bien.
Je l'ai juste adaptée à mes besoins.
Je suis effectivement un peu faiblard dans l'utilisation des fonctions de
chaîne (s'il n'y avait que là...).
J'ai là matière à les travailler.
Ah, au fait, Merci !
:-))
Michel"
Merci à toi aussi Jacky
Michel
"Jacky" a écrit dans le message de
news:4c667ec4$0$5400$Bonjour Michel
Je te transmet une reponse de Denis sur Answers,
Debut copie
'------------------
(Comme la communication est impossible sur aioe.org
J'espère que quelqu'un aura la générosité de lui transmettre...
2 Procédures :
Incrémenter toute la colonne A
La dernière lettre K a été omise, faute d'information adéquate.
Adapter le nom de la feuille si besoin...
'-------------------------------------
Sub Incrémentation_Sur_Toute_La_Colonne()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long, ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Feuil1")
'Valeur de la première cellule
.Range("A1") = "AA-1001"
'Dernière ligne de la feuille -1
DerLig = .Range("A:A").Rows.Count - 1
'Boucle sur chaque ligne de la feuille
For Each C In .Range("A1:A" & DerLig)
T = Split(C.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
C.Offset(1) = R
Next
End With
Application.EnableEvents = True
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
End Sub
'-------------------------------------
Une cellule à la fois, la ligne 1 est présumée être l'étiquette de
colonne
'-------------------------------------
Sub Incrémentation_Une_Ligne_à_La_Fois()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long
With Worksheets("Feuil1")
With .Range("A" & .Range("A" & .Cells.Rows.Count).End(xlUp).Row)
If .Address = "$A$1" Then
If .Offset(1).Value = "" Then
.Offset(1).Value = "AA-1001"
Exit Sub
End If
Else
T = Split(.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
.Offset(1).Value = R
End If
End With
End With
End Sub
--------------------------------------------------------------------------------
MichD
'-------------Fin copie----------------
--
Salutations
JJ
"Péhemme" a écrit dans le message de news:
4c65cc28$0$10196$Bonjour(soir) à Tous,
J'ai un problème d'incrémentation alphabétique tordue.
J'ai une base de données qui s'alimente via des TextBox et Label placés
sur un UserForm.
Au moment de la saisie, un Label doit être rempli automatiquement en
allant chercher dans la BdD le n° précédent incrémenté de 1.
1°) Première partie à incrémenter (déjà tordue) : la série :
La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait
a) numériquement de 1001 à 9999
b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001
à ZZ-9999)
Si cela peut aider, on peut supprimer le tiret utilisé comme
séparateur. Sa présence a pour but d'obtenir une lecture plus facile du
n° complet.
2°) Seconde partie : la lettre finale :
Elle doit s'incrémenter de K (plus petit caractère) à Z (le plus
grand). Cette incrémentation, bien que liée au n° de série, est
indépendante de celui-ci (une série quelconque peut, à titre d'exemple,
ne posséder que 3 lettres finales distinctes (K, L ou M par exemple).
Mais au minimum un seul élément dans la série : K.
Le plus petit n° complet s'écrit donc AA-1001-K
Je n'ai pas encore traité ce dernier point, mais je me débrouillerai.
Ne sachant pas comment faire, j'ai solutionné le problème du n° de
série :
a) en créant 4 colonnes dans ma BdD et 4 Label (dont 3 invisibles)
sur mon UserForm
b) en écrivant la macro suivante qui répond à mon problème mais qui
me semble « contorsionniste et bourrin ».
L'un d'entre vous sait-il si je peux, et dans la série « j'ai la plus
courte », incrémenter directement mes séries sans passer par la
dichotomie de son n°.
Merci d'avance de vos avis et commentaires.
La macro :
Private Sub UserForm_Initialize()
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim R As Long
If R = 65535 Then
MsgBox "Vous êtes à la fin de la page !"
GoTo Fin
Else
R = Sheets("Feuil1").Range("G65536").End(xlUp).Row
End If
'Une première ligne est déjà remplie à A, A, 1000 pour rentrer dans la
boucle
x = Range("G" & R).Value + 1
y = Asc(Range("Feuil1!F65536").End(xlUp).Value)
z = Asc(Range("Feuil1!E65536").End(xlUp).Value)
If x = 10000 Then
x = 1001
y = y + 1
If y = 91 Then
y = 65
z = z + 1
If z = 91 Then
GoTo Fin
End If
End If
End If
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
Label1 = Chr(z)
Label2 = Chr(y)
Label3 = x
Label4 = Label1 & Label2 & "-" & Label3
Exit Sub
Fin:
MsgBox "Vous êtes au maximum autorisé", vbCritical, "ATTENTION
LIMITES !"
End Sub
Bonne nuit
Michel
Re..
Tu peux dire à Denis :
S'il ne peut pas émettre sur aioe.org, il peut néanmoins lire les news.
Donc, pas besoin de lui transmettre ;o))
--
Bon we
Jacky
"Péhemme" <xx@xx.xx> a écrit dans le message de news:
4c669cf7$0$5390$ba4acef3@reader.news.orange.fr...
Bonjour Jacky
Merci à toi de jouer les transmetteurs.
Il faudra bien qu'un jour j'installe ce fameux bridge...
Tu peux dire à Denis :
"Ta macro (au cas par cas) fonctionne parfaitement bien.
Je l'ai juste adaptée à mes besoins.
Je suis effectivement un peu faiblard dans l'utilisation des fonctions de
chaîne (s'il n'y avait que là...).
J'ai là matière à les travailler.
Ah, au fait, Merci !
:-))
Michel"
Merci à toi aussi Jacky
Michel
"Jacky" <Dupond@marcel.fr> a écrit dans le message de
news:4c667ec4$0$5400$ba4acef3@reader.news.orange.fr...
Bonjour Michel
Je te transmet une reponse de Denis sur Answers,
Debut copie
'------------------
(Comme la communication est impossible sur aioe.org
J'espère que quelqu'un aura la générosité de lui transmettre...
2 Procédures :
Incrémenter toute la colonne A
La dernière lettre K a été omise, faute d'information adéquate.
Adapter le nom de la feuille si besoin...
'-------------------------------------
Sub Incrémentation_Sur_Toute_La_Colonne()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long, ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Feuil1")
'Valeur de la première cellule
.Range("A1") = "AA-1001"
'Dernière ligne de la feuille -1
DerLig = .Range("A:A").Rows.Count - 1
'Boucle sur chaque ligne de la feuille
For Each C In .Range("A1:A" & DerLig)
T = Split(C.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
C.Offset(1) = R
Next
End With
Application.EnableEvents = True
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
End Sub
'-------------------------------------
Une cellule à la fois, la ligne 1 est présumée être l'étiquette de
colonne
'-------------------------------------
Sub Incrémentation_Une_Ligne_à_La_Fois()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long
With Worksheets("Feuil1")
With .Range("A" & .Range("A" & .Cells.Rows.Count).End(xlUp).Row)
If .Address = "$A$1" Then
If .Offset(1).Value = "" Then
.Offset(1).Value = "AA-1001"
Exit Sub
End If
Else
T = Split(.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
.Offset(1).Value = R
End If
End With
End With
End Sub
--------------------------------------------------------------------------------
MichD
'-------------Fin copie----------------
--
Salutations
JJ
"Péhemme" <xx@xx.xx> a écrit dans le message de news:
4c65cc28$0$10196$ba4acef3@reader.news.orange.fr...
Bonjour(soir) à Tous,
J'ai un problème d'incrémentation alphabétique tordue.
J'ai une base de données qui s'alimente via des TextBox et Label placés
sur un UserForm.
Au moment de la saisie, un Label doit être rempli automatiquement en
allant chercher dans la BdD le n° précédent incrémenté de 1.
1°) Première partie à incrémenter (déjà tordue) : la série :
La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait
a) numériquement de 1001 à 9999
b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001
à ZZ-9999)
Si cela peut aider, on peut supprimer le tiret utilisé comme
séparateur. Sa présence a pour but d'obtenir une lecture plus facile du
n° complet.
2°) Seconde partie : la lettre finale :
Elle doit s'incrémenter de K (plus petit caractère) à Z (le plus
grand). Cette incrémentation, bien que liée au n° de série, est
indépendante de celui-ci (une série quelconque peut, à titre d'exemple,
ne posséder que 3 lettres finales distinctes (K, L ou M par exemple).
Mais au minimum un seul élément dans la série : K.
Le plus petit n° complet s'écrit donc AA-1001-K
Je n'ai pas encore traité ce dernier point, mais je me débrouillerai.
Ne sachant pas comment faire, j'ai solutionné le problème du n° de
série :
a) en créant 4 colonnes dans ma BdD et 4 Label (dont 3 invisibles)
sur mon UserForm
b) en écrivant la macro suivante qui répond à mon problème mais qui
me semble « contorsionniste et bourrin ».
L'un d'entre vous sait-il si je peux, et dans la série « j'ai la plus
courte », incrémenter directement mes séries sans passer par la
dichotomie de son n°.
Merci d'avance de vos avis et commentaires.
La macro :
Private Sub UserForm_Initialize()
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim R As Long
If R = 65535 Then
MsgBox "Vous êtes à la fin de la page !"
GoTo Fin
Else
R = Sheets("Feuil1").Range("G65536").End(xlUp).Row
End If
'Une première ligne est déjà remplie à A, A, 1000 pour rentrer dans la
boucle
x = Range("G" & R).Value + 1
y = Asc(Range("Feuil1!F65536").End(xlUp).Value)
z = Asc(Range("Feuil1!E65536").End(xlUp).Value)
If x = 10000 Then
x = 1001
y = y + 1
If y = 91 Then
y = 65
z = z + 1
If z = 91 Then
GoTo Fin
End If
End If
End If
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
Label1 = Chr(z)
Label2 = Chr(y)
Label3 = x
Label4 = Label1 & Label2 & "-" & Label3
Exit Sub
Fin:
MsgBox "Vous êtes au maximum autorisé", vbCritical, "ATTENTION
LIMITES !"
End Sub
Bonne nuit
Michel
Re..Tu peux dire à Denis :
S'il ne peut pas émettre sur aioe.org, il peut néanmoins lire les news.
Donc, pas besoin de lui transmettre ;o))
--
Bon we
Jacky
"Péhemme" a écrit dans le message de news:
4c669cf7$0$5390$Bonjour Jacky
Merci à toi de jouer les transmetteurs.
Il faudra bien qu'un jour j'installe ce fameux bridge...
Tu peux dire à Denis :
"Ta macro (au cas par cas) fonctionne parfaitement bien.
Je l'ai juste adaptée à mes besoins.
Je suis effectivement un peu faiblard dans l'utilisation des fonctions de
chaîne (s'il n'y avait que là...).
J'ai là matière à les travailler.
Ah, au fait, Merci !
:-))
Michel"
Merci à toi aussi Jacky
Michel
"Jacky" a écrit dans le message de
news:4c667ec4$0$5400$Bonjour Michel
Je te transmet une reponse de Denis sur Answers,
Debut copie
'------------------
(Comme la communication est impossible sur aioe.org
J'espère que quelqu'un aura la générosité de lui transmettre...
2 Procédures :
Incrémenter toute la colonne A
La dernière lettre K a été omise, faute d'information adéquate.
Adapter le nom de la feuille si besoin...
'-------------------------------------
Sub Incrémentation_Sur_Toute_La_Colonne()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long, ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Feuil1")
'Valeur de la première cellule
.Range("A1") = "AA-1001"
'Dernière ligne de la feuille -1
DerLig = .Range("A:A").Rows.Count - 1
'Boucle sur chaque ligne de la feuille
For Each C In .Range("A1:A" & DerLig)
T = Split(C.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
C.Offset(1) = R
Next
End With
Application.EnableEvents = True
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
End Sub
'-------------------------------------
Une cellule à la fois, la ligne 1 est présumée être l'étiquette de
colonne
'-------------------------------------
Sub Incrémentation_Une_Ligne_à_La_Fois()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long
With Worksheets("Feuil1")
With .Range("A" & .Range("A" & .Cells.Rows.Count).End(xlUp).Row)
If .Address = "$A$1" Then
If .Offset(1).Value = "" Then
.Offset(1).Value = "AA-1001"
Exit Sub
End If
Else
T = Split(.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
.Offset(1).Value = R
End If
End With
End With
End Sub
--------------------------------------------------------------------------------
MichD
'-------------Fin copie----------------
--
Salutations
JJ
"Péhemme" a écrit dans le message de news:
4c65cc28$0$10196$Bonjour(soir) à Tous,
J'ai un problème d'incrémentation alphabétique tordue.
J'ai une base de données qui s'alimente via des TextBox et Label placés
sur un UserForm.
Au moment de la saisie, un Label doit être rempli automatiquement en
allant chercher dans la BdD le n° précédent incrémenté de 1.
1°) Première partie à incrémenter (déjà tordue) : la série :
La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait
a) numériquement de 1001 à 9999
b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001
à ZZ-9999)
Si cela peut aider, on peut supprimer le tiret utilisé comme
séparateur. Sa présence a pour but d'obtenir une lecture plus facile du
n° complet.
2°) Seconde partie : la lettre finale :
Elle doit s'incrémenter de K (plus petit caractère) à Z (le plus
grand). Cette incrémentation, bien que liée au n° de série, est
indépendante de celui-ci (une série quelconque peut, à titre d'exemple,
ne posséder que 3 lettres finales distinctes (K, L ou M par exemple).
Mais au minimum un seul élément dans la série : K.
Le plus petit n° complet s'écrit donc AA-1001-K
Je n'ai pas encore traité ce dernier point, mais je me débrouillerai.
Ne sachant pas comment faire, j'ai solutionné le problème du n° de
série :
a) en créant 4 colonnes dans ma BdD et 4 Label (dont 3 invisibles)
sur mon UserForm
b) en écrivant la macro suivante qui répond à mon problème mais qui
me semble « contorsionniste et bourrin ».
L'un d'entre vous sait-il si je peux, et dans la série « j'ai la plus
courte », incrémenter directement mes séries sans passer par la
dichotomie de son n°.
Merci d'avance de vos avis et commentaires.
La macro :
Private Sub UserForm_Initialize()
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim R As Long
If R = 65535 Then
MsgBox "Vous êtes à la fin de la page !"
GoTo Fin
Else
R = Sheets("Feuil1").Range("G65536").End(xlUp).Row
End If
'Une première ligne est déjà remplie à A, A, 1000 pour rentrer dans la
boucle
x = Range("G" & R).Value + 1
y = Asc(Range("Feuil1!F65536").End(xlUp).Value)
z = Asc(Range("Feuil1!E65536").End(xlUp).Value)
If x = 10000 Then
x = 1001
y = y + 1
If y = 91 Then
y = 65
z = z + 1
If z = 91 Then
GoTo Fin
End If
End If
End If
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
Label1 = Chr(z)
Label2 = Chr(y)
Label3 = x
Label4 = Label1 & Label2 & "-" & Label3
Exit Sub
Fin:
MsgBox "Vous êtes au maximum autorisé", vbCritical, "ATTENTION
LIMITES !"
End Sub
Bonne nuit
Michel
Bonjour
2 Procédures :
Incrémenter toute la colonne A
La dernière lettre K a été omise, faute d'information adéquate.
Adapter le nom de la feuille si besoin...
Sub Incrémentation_Sur_Toute_La_Colonne()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long, ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Feuil1")
'Valeur de la première cellule
.Range("A1") = "AA-1001"
'Dernière ligne de la feuille -1
DerLig = .Range("A:A").Rows.Count - 1
'Boucle sur chaque ligne de la feuille
For Each C In .Range("A1:A" & DerLig)
T = Split(C.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
C.Offset(1) = R
Next
End With
Application.EnableEvents = True
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
End Sub
Une cellule à la fois, la ligne 1 est présumée être l'étiquette de colonne
Sub Incrémentation_Une_Ligne_à_La_Fois()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long
With Worksheets("Feuil1")
With .Range("A" & .Range("A" & .Cells.Rows.Count).End(xlUp).Row)
If .Address = "$A$1" Then
If .Offset(1).Value = "" Then
.Offset(1).Value = "AA-1001"
Exit Sub
End If
Else
T = Split(.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
.Offset(1).Value = R
End If
End With
End With
End Sub
--
MichD
--------------------------------------------
"Péhemme" a écrit dans le message de groupe de discussion :
4c667599$0$5428$
Mon cher Maude (ou ma chère Gilbert) :-)),
Tu vois effectivement que je continue de "m'accrocher" et ce, sans changer
de sexe, mais pourquoi tu me fais un tirage aléatoire au lieu d'une
incrémentation "toute bête" (+1 à chaque fois, sauf aux sauts de pas
spécifiés) ? Tu veux vérifier si je suis ?... :-))
Merci de ton aide, je regarde si je peux adapter ta réponse.
Bien amicalement
Michel
"Maude Este" a écrit dans le message de
news:i45j3t$fts$Bonsour®
"Péhemme" a écrit1°) Première partie à incrémenter (déjà tordue) : la série :
La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait
a) numériquement de 1001 à 9999
b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001 à
ZZ-9999)
Sub test()
MsgBox "Ctrl-Pause pour interrompre ce test", vbExclamation, "Michel On
s'accroche !!!"
[A1] = Chr(65 + Rnd() * 26) & Chr(65 + Rnd() * 26) & "-" & Format(Rnd() *
10 ^ 4, "0000")
For i = 1 To 20000
increment
DoEvents
Next
End Sub
Sub increment()
x = [A1]
alpha1 = Asc(UCase(Left(x, 1)))
alpha2 = Asc(UCase(Mid(x, 2, 1)))
nombre = CInt(Right(x, 4))
'-----incrementation numerique
nombre = nombre + 1
'-----incrementation 2éme lettre
If nombre > 9999 Then
alpha2 = alpha2 + 1
nombre = 0
End If
'-----incrementation 1ére lettre
If alpha2 > Asc("Z") Then
alpha2 = 65
alpha1 = alpha1 + 1
End If
'----- limite capacité
If alpha1 > Asc("Z") Then
MsgBox "limite capacité atteinte AA-9999"
Exit Sub
End If
'-----
[A1] = Chr(alpha1) & Chr(alpha2) & "-" & Format(nombre, "0000")
End Sub
Bonjour
2 Procédures :
Incrémenter toute la colonne A
La dernière lettre K a été omise, faute d'information adéquate.
Adapter le nom de la feuille si besoin...
Sub Incrémentation_Sur_Toute_La_Colonne()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long, ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Feuil1")
'Valeur de la première cellule
.Range("A1") = "AA-1001"
'Dernière ligne de la feuille -1
DerLig = .Range("A:A").Rows.Count - 1
'Boucle sur chaque ligne de la feuille
For Each C In .Range("A1:A" & DerLig)
T = Split(C.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
C.Offset(1) = R
Next
End With
Application.EnableEvents = True
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
End Sub
Une cellule à la fois, la ligne 1 est présumée être l'étiquette de colonne
Sub Incrémentation_Une_Ligne_à_La_Fois()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long
With Worksheets("Feuil1")
With .Range("A" & .Range("A" & .Cells.Rows.Count).End(xlUp).Row)
If .Address = "$A$1" Then
If .Offset(1).Value = "" Then
.Offset(1).Value = "AA-1001"
Exit Sub
End If
Else
T = Split(.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
.Offset(1).Value = R
End If
End With
End With
End Sub
--
MichD
--------------------------------------------
"Péhemme" <xx@xx.xx> a écrit dans le message de groupe de discussion :
4c667599$0$5428$ba4acef3@reader.news.orange.fr...
Mon cher Maude (ou ma chère Gilbert) :-)),
Tu vois effectivement que je continue de "m'accrocher" et ce, sans changer
de sexe, mais pourquoi tu me fais un tirage aléatoire au lieu d'une
incrémentation "toute bête" (+1 à chaque fois, sauf aux sauts de pas
spécifiés) ? Tu veux vérifier si je suis ?... :-))
Merci de ton aide, je regarde si je peux adapter ta réponse.
Bien amicalement
Michel
"Maude Este" <nomail@live.fr> a écrit dans le message de
news:i45j3t$fts$1@speranza.aioe.org...
Bonsour®
"Péhemme" a écrit
1°) Première partie à incrémenter (déjà tordue) : la série :
La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait
a) numériquement de 1001 à 9999
b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001 à
ZZ-9999)
Sub test()
MsgBox "Ctrl-Pause pour interrompre ce test", vbExclamation, "Michel On
s'accroche !!!"
[A1] = Chr(65 + Rnd() * 26) & Chr(65 + Rnd() * 26) & "-" & Format(Rnd() *
10 ^ 4, "0000")
For i = 1 To 20000
increment
DoEvents
Next
End Sub
Sub increment()
x = [A1]
alpha1 = Asc(UCase(Left(x, 1)))
alpha2 = Asc(UCase(Mid(x, 2, 1)))
nombre = CInt(Right(x, 4))
'-----incrementation numerique
nombre = nombre + 1
'-----incrementation 2éme lettre
If nombre > 9999 Then
alpha2 = alpha2 + 1
nombre = 0
End If
'-----incrementation 1ére lettre
If alpha2 > Asc("Z") Then
alpha2 = 65
alpha1 = alpha1 + 1
End If
'----- limite capacité
If alpha1 > Asc("Z") Then
MsgBox "limite capacité atteinte AA-9999"
Exit Sub
End If
'-----
[A1] = Chr(alpha1) & Chr(alpha2) & "-" & Format(nombre, "0000")
End Sub
Bonjour
2 Procédures :
Incrémenter toute la colonne A
La dernière lettre K a été omise, faute d'information adéquate.
Adapter le nom de la feuille si besoin...
Sub Incrémentation_Sur_Toute_La_Colonne()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long, ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Feuil1")
'Valeur de la première cellule
.Range("A1") = "AA-1001"
'Dernière ligne de la feuille -1
DerLig = .Range("A:A").Rows.Count - 1
'Boucle sur chaque ligne de la feuille
For Each C In .Range("A1:A" & DerLig)
T = Split(C.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
C.Offset(1) = R
Next
End With
Application.EnableEvents = True
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
End Sub
Une cellule à la fois, la ligne 1 est présumée être l'étiquette de colonne
Sub Incrémentation_Une_Ligne_à_La_Fois()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long
With Worksheets("Feuil1")
With .Range("A" & .Range("A" & .Cells.Rows.Count).End(xlUp).Row)
If .Address = "$A$1" Then
If .Offset(1).Value = "" Then
.Offset(1).Value = "AA-1001"
Exit Sub
End If
Else
T = Split(.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
.Offset(1).Value = R
End If
End With
End With
End Sub
--
MichD
--------------------------------------------
"Péhemme" a écrit dans le message de groupe de discussion :
4c667599$0$5428$
Mon cher Maude (ou ma chère Gilbert) :-)),
Tu vois effectivement que je continue de "m'accrocher" et ce, sans changer
de sexe, mais pourquoi tu me fais un tirage aléatoire au lieu d'une
incrémentation "toute bête" (+1 à chaque fois, sauf aux sauts de pas
spécifiés) ? Tu veux vérifier si je suis ?... :-))
Merci de ton aide, je regarde si je peux adapter ta réponse.
Bien amicalement
Michel
"Maude Este" a écrit dans le message de
news:i45j3t$fts$Bonsour®
"Péhemme" a écrit1°) Première partie à incrémenter (déjà tordue) : la série :
La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait
a) numériquement de 1001 à 9999
b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001 à
ZZ-9999)
Sub test()
MsgBox "Ctrl-Pause pour interrompre ce test", vbExclamation, "Michel On
s'accroche !!!"
[A1] = Chr(65 + Rnd() * 26) & Chr(65 + Rnd() * 26) & "-" & Format(Rnd() *
10 ^ 4, "0000")
For i = 1 To 20000
increment
DoEvents
Next
End Sub
Sub increment()
x = [A1]
alpha1 = Asc(UCase(Left(x, 1)))
alpha2 = Asc(UCase(Mid(x, 2, 1)))
nombre = CInt(Right(x, 4))
'-----incrementation numerique
nombre = nombre + 1
'-----incrementation 2éme lettre
If nombre > 9999 Then
alpha2 = alpha2 + 1
nombre = 0
End If
'-----incrementation 1ére lettre
If alpha2 > Asc("Z") Then
alpha2 = 65
alpha1 = alpha1 + 1
End If
'----- limite capacité
If alpha1 > Asc("Z") Then
MsgBox "limite capacité atteinte AA-9999"
Exit Sub
End If
'-----
[A1] = Chr(alpha1) & Chr(alpha2) & "-" & Format(nombre, "0000")
End Sub
