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

ksimat · 19 Septembre 2017

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 · 19 Septembre 2017

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

Code:

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

DoubleZero · 19 Septembre 2017

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 · 19 Septembre 2017

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 · 19 Septembre 2017

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 · 19 Septembre 2017

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 · 19 Septembre 2017

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 · 19 Septembre 2017

Re-bonjour,

ksimat à dit:
... J'ai cherché et vu "les fleurs" (sic)...

Merci, ksimat !

ksimat à dit:
... 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 · 19 Septembre 2017

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 · 19 Septembre 2017

Re-bonjour,

ksimat à dit:
... 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 · 19 Septembre 2017

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 · 19 Septembre 2017

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 · 20 Septembre 2017

Bonjour à toutes et à tous,

ChTi160 à dit:
... 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 · 1 Octobre 2017

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 · 1 Octobre 2017

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

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

ksimat

XLDnaute Junior

Pièces jointes

M12

XLDnaute Accro

DoubleZero

XLDnaute Barbatruc

ksimat

XLDnaute Junior

Pièces jointes

DoubleZero

XLDnaute Barbatruc

ksimat

XLDnaute Junior

ksimat

XLDnaute Junior

DoubleZero

XLDnaute Barbatruc

ksimat

XLDnaute Junior

DoubleZero

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

ksimat

XLDnaute Junior

DoubleZero

XLDnaute Barbatruc

ksimat

XLDnaute Junior

Pièces jointes

ChTi160

XLDnaute Barbatruc

Pièces jointes

Discussions similaires