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

ksimat

XLDnaute Junior
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
 

Pièces jointes

  • matricule alphanumerique.xlsx
    11.2 KB · Affichages: 57
Dernière édition:

DoubleZero

XLDnaute Barbatruc
Bonjour, ksimat, M12,

Autre possibilité avec le code ci-après, logé dans ThisWorkbook :
VB:
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

XLDnaute Junior
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
 

Pièces jointes

  • matricule alphanumerique.xlsx
    11.2 KB · Affichages: 32

DoubleZero

XLDnaute Barbatruc
Re-bonjour,

Est-ce mieux comme ceci ?
VB:
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

XLDnaute Junior
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

XLDnaute Barbatruc
Re-bonjour,
... J'ai cherché et vu "les fleurs" (sic)...
Merci, ksimat :D !

... 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
Code:
.Offset(, 16) = ""
par
Code:
'.Offset(, 16) = ""
Ne pas hésiter à demander d'autres explications.

A bientôt :)
 

ksimat

XLDnaute Junior
Re-Bonjour DoubleZerro,
WAW! J'ai vu et trouvé. Et quelle FLEUR! :eek:
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
 

ChTi160

XLDnaute Barbatruc
Bonsoir Ksimat
Bonsoir Le Fil ,DoubleZero ,le forum
une possibilité peut être , d'éviter le Offset(,16)
VB:
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

XLDnaute Junior
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
 

Pièces jointes

  • matricule alphanumerique.xlsm
    20.5 KB · Affichages: 16

ChTi160

XLDnaute Barbatruc
Bonjour ksimat
Bonjour le Fil ,Le Forum
une approche
VB:
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
 

Pièces jointes

  • matricule alphanumerique chti160.xlsm
    24.1 KB · Affichages: 28

Statistiques des forums

Discussions
311 720
Messages
2 081 898
Membres
101 834
dernier inscrit
Jeremy06510