Matricule alphanumérique en associant le nom de l’onglet, l’année en cours et un compteur de trois c

[ksimat]

Bonjour à toutes et à tous,

Je sais qu’il y a eu sur le NET plusieurs postes sur ce sujet mais je n’ai malheureusement pas trouvé de réponse qui règle mon problème. Je voudrais dans une petite base de données générer par macro des matricules automatiques qui seraient composés du nom de l’onglet + l’année en cours + un compteur de trois chiffres commençant par 001.

Je voudrais dès que je saisis le nom de la personne à inscrire en (B2), un matricule alphanumérique lui soit automatiquement assigné en (A2) en récupérant le nom de l'onglet + l’année en cours suivi 3 chiffres (001).

Exemple: Sous l’onglet dénommé MAS le matricule de toto devrait être MAS2017001, celui de son suivant MAS2017002.

Je joins un fichier test pour de plus amples détails.

Merci d’avance à tous ceux qui passeront.

Ksimat

 

[M12]

Bonjour,
Teste avec cette formule à mettre en A2 de chaque onglet et tirer vers le bas

=SI(B2="";"";DROITE(CELLULE("nomfichier");3)&ANNEE(AUJOURDHUI())&TEXTE(LIGNE(A1);"000"))

 

[DoubleZero]

Bonjour, ksimat, M12,

Autre possibilité avec le code ci-après, logé dans ThisWorkbook :

Option Explicit
Private Sub Workbook_SheetChange(ByVal o As Object, ByVal c As Range)
    Select Case o.Name
    Case "MAS", "DRK", "KLM"
        If c.Column <> 2 Or c.Row < 2 Or c.Count > 1 Then Exit Sub
        With Selection.Offset(-1, -1)
            .Offset(, 16).Value = "=Text(Row()-1, ""000"")"
            .Value = o.Name & Year(Date) & .Offset(, 16)
            .Offset(, 16) = ""
        End With
        If c = "" Then c.Offset(, -1) = ""
    End Select
End Sub

A bientôt

 

[ksimat]

Bonjour M12, DoubleZerro et à tous les autres,
D'abord un grand MERCI pour votre aide. J'ai testé les deux propositions (la formule de M12 et la macro de DoubleZerro); toutes les deux marchent mais chacune avec un petit handicap. Pour la formule à tirer dans la colonne A, je veux l'écarter car la colonne est déjà utilisée par une autre fonction dans une macro
Sheets(s).[A1].CurrentRegion.Offset(1, 0).Copy _
Sheets("RECAPITULATIF").[A65000].End(xlUp).Offset(1, 0) .
Quant à la macro de DoubleZerro elle ferait l'affaire sauf que le matricule qui doit nécessairement être inscrit dans la cellule de gauche c'est à dire en colonne A, est mis dans la cellule d'en haut si je valide par la touche de direction DROITE. Si je valide l'inscription en B2 par la touche ENTER ou la touche de direction BAS, le matricule est inscrit au bon endroit en A2. Et jamais je quitte la B2 par la touche GAUCHE, alors là boum : BUG.
Je ne m'y connais pas trop en vba mais j'ose soupçonner que ce problème vient de la ligne [ With Selection.Offset(-1, -1) ].

Voilà, en espérant d'avoir été assez clair dans mes explications laborieuses, je vous redis merci.
Ksimat

 

[DoubleZero]

Re-bonjour,

Est-ce mieux comme ceci ?

Option Explicit
Private Sub Workbook_SheetChange(ByVal o As Object, ByVal c As Range) ' v2
    Select Case o.Name
    Case "MAS", "DRK", "KLM"
        If c.Column <> 2 Or c.Row < 2 Or c.Count > 1 Then Exit Sub
        c.Name = "toto"
        With Range("toto").Offset(, -1)
            .Offset(, 16).Value = "=Text(Row()-1, ""000"")"
            .Value = o.Name & Year(Date) & .Offset(, 16)
            .Offset(, 16) = ""
        End With
        If c = "" Then c.Offset(, -1) = ""
    End Select
End Sub

A bientôt

 

[ksimat]

Re-Bonjour DoubleZerro,
A priori cela semble convenir. Mais je vais pousser les test plus loin et je vous reviens.
Merci pour tout!
Ksimat

 

[ksimat]

Salutations à tous particulièrement à DoubleZerro,
DoubleZerro votre macro marche à merveille. Je l'ai testé et éprouvé dans "toutes" les situations et elle demeure irréprochable et moi très satisfait. J'ai cherché et vu "les fleurs" (sic) qui se cachent dans la macro sauf qu'il me reste à comprendre le pourquoi du "16" de .Offset(, 16). J'espère dénicher cette pétale.
Je valide: Il y a des fleurs partout pour qui veut bien les voir. (Henri MATISSE)
Encore MERCI
Ksimat

 

[DoubleZero]

Re-bonjour,

... J'ai cherché et vu "les fleurs" (sic)...

Merci, ksimat !

... il me reste à comprendre le pourquoi du "16" de .Offset(, 16)...

Je n'ai pas su faire autrement que d'insérer en colonne q le format personnalisé "000" qui sera, par la suite, précédé du nom d'onglet et de l'année.

Afin de mieux comprendre :

remplacer

.Offset(, 16) = ""

par

'.Offset(, 16) = ""

Ne pas hésiter à demander d'autres explications.

A bientôt

 

[ksimat]

Re-Bonjour DoubleZerro,
WAW! J'ai vu et trouvé. Et quelle FLEUR!
j'en ai profité pour le décaler dans une colonne plus éloignée [ .offset(, 51) ] car la (, 16) est prévu pour recevoir des données. Vous remarquerez que cette "fleur" commence déjà à donner des "fruits".
Ce soir je dormirai moins bête grâce à ce forum et à ses membres.
Toute ma gratitude à tous particulièrement à DoubleZerro et à M12.
Merci
Ksimat

 

[DoubleZero]

Re-bonjour,

... J'ai vu et trouvé... j'en ai profité pour le décaler dans une colonne plus éloignée [ .offset(, 51) ]...

Brav et à bientôt

 

[ChTi160]

Bonsoir Ksimat
Bonsoir Le Fil ,DoubleZero ,le forum
une possibilité peut être , d'éviter le Offset(,16)

Private Sub Workbook_SheetChange(ByVal o As Object, ByVal c As Range) ' v2
    Select Case o.Name
    Case "MAS", "DRK", "KLM"
        If c.Column <> 2 Or c.Row < 2 Or c.Count > 1 Then Exit Sub
          With c.Offset(, -1)
                     .Value = o.Name & Year(Date) & Format(.Row - 1, "000")
          End With
        If c = "" Then c.Offset(, -1) = ""
    End Select
End Sub

Bonne fin de Soirée
Amicalement
Jean marie

 

[ksimat]

Bonsoir Jean Marie, le fil et tous ceux qui passeront,
Je confirme que "cette voie de contournement" est aussi efficace et pertinente.
Merci pour la leçon.
Ksimat

 

[DoubleZero]

Bonjour à toutes et à tous,

... une possibilité peut être , d'éviter le Offset(,16)...

Non : pas "peut être" mais la bonne syntaxe que j'ai vainement cherchée.

Grands brav et merci, ChTi160.

A bientôt

 

[ksimat]

Bonjour à toutes et tous ceux qui passeront,

Je me permets de relancer ce fil que j’avais ouvert il y a quelques jours. De bonnes volontés (DoubleZerro et ChTi160 notamment – je continue de les remercier toujours) m’avaient trouvé le code ci-dessous qui me permet de générer automatiquement en colonne A un matricule dès qu’un prénom est saisi en colonne B. La macro fonctionne tant que la saisie se fait par clic en cellules de la colonne B. Mais (parce qu’il y a un « mais ») si une liste de prénoms est copiée ailleurs puis collée dans la colonne B, les matricules ne sont plus générés automatiquement. Pour ce faire il faut faire un double-clic sur chaque prénom (cellule B) de la liste collée pour déclencher la génération de chaque matricule ou copier et coller les éléments de la liste un par un.

Je voudrais, si possible, pouvoir insérer les données par liste copiée et collée. Je joins mon fichier de test en réitérant mes remerciements à toutes les personnes qui voudront bien se pencher sur mon problème.

Ksimat

Private Sub Workbook_SheetChange(ByVal o As Object, ByVal c As Range) ' v2
Select Case o.Name
Case "MAS", "DRK", "KLM"
If c.Column <> 2 Or c.Row < 2 Or c.Count > 1 Then Exit Sub
With c.Offset(, -1)
.Value = o.Name & Year(Date) & Format(.Row - 1, "000")
End With
If c = "" Then c.Offset(, -1) = ""
End Select
End Sub

 

[ChTi160]

Bonjour ksimat
Bonjour le Fil ,Le Forum
une approche

Private Sub Workbook_SheetChange(ByVal o As Object, ByVal c As Range) ' v2
Dim oC As Range
    With Application
         .ScreenUpdating = False
    End With
If c.Column <> 2 Or c.Row < 2 Then Exit Sub 'si colonne differente de la 2 et Ligne inferieure a 2 "On quitte"
If c.Rows.Count = 1 Then 'si la plage traite est composee d'une ligne
 Select Case o.Name 'selon le nom de la feuille ou a lieu le Changement
        Case "MAS", "DRK", "KLM" 'si le Nom est l'un de de ces Noms
            With c.Offset(, -1) 'Avec la cellule à gauche de la cellule concernée
                  .Value = o.Name & Year(Date) & Format(.Row - 1, "000") 'on colle les donnees ainsi definies
            End With
        If c = "" Then c.Offset(, -1) = "" 'si la cellule concernée est Vide on vide la Cellule à sa gauche
 End Select
   ElseIf c.Rows.Count > 1 Then 'si la plage traitee est composee de plus d'une ligne
  For Each oC In c 'pour chaque lignes de cette Plage
     Select Case o.Name 'selon le nom de la feuille ou a lieu le Changement
        Case "MAS", "DRK", "KLM" 'si le Nom est l'un de de ces Noms
        With oC.Offset(, -1)
        .Value = o.Name & Year(Date) & Format(.Row - 1, "000") 'on colle les donnees ainsi definies
        End With
        If oC = "" Then oC.Offset(, -1) = ""  'si la cellule concernée est Vide , on vide la Cellule à sa gauche
     End Select
  Next oC
End If
    With Application
         .CutCopyMode = False
         .ScreenUpdating = True
    End With
End Sub

Bonne Journée
Amicalement
Jean marie