Microsoft 365 Insérer les 2 derniers chiffre de l'année en cours

Patoche42

XLDnaute Junior
Bonjour à tous,
Je sollicite encore une fois vos talents .Je me suis mis au VBA depuis peu et cela fait des heures que je suis dessus et je n'arrive pas à résoudre mon problème.
J'ai 2 soucis:
1 - J'aimerai insérer une ligne vide à la suite de mon tableau mais en gardant les formules de ligne précédente( colonne A et O) à l'aide d'un bouton.
Le bouton "insérer une ligne" que j'ai créer ne recopie que la formule de la colonne A et je ne comprend pas pourquoi.
En sachant que les N° de la colonne A pourrais peut être incrémenter automatiquement via une macro (je n'y suis pas arrivé:confused:)

2 - Le 2eme bouton serait pour créer une nouvelle série de N° de rapport en début d'année.
La macro que j'utilise, crée un N° par rapport à la date encours mais m'efface mes formules. En sachant que j'aimerais que le N° s'affiche comme suis:
Ex : 22001 (22 pour les 2 dernier chiffres de l'année + 001 pour le premier rapport de l'année)

J'espère avoir été assez clair.
Si vous créez de nouvelle macro dans mon fichier est ce que vous pouvez insérer des commentaires à chaque étape de la macro, pour que je comprenne le déroulement de celle-ci.
Je vous remercie par avance.
 

Pièces jointes

  • NEW Gestion Rapport - Copie.xlsm
    33.2 KB · Affichages: 9
Solution
Re,
excat, je n'y avais pas penser.
Ci dessous le N° de l'action revient à 001 si l'année change ( par ex 21048 puis 22001 )
Code:
Sub InsererDateEtHeure()
    Dim DernièreAction%, NouvelleAction$, DL%
    DL = Range("A65500").End(xlUp).Row
    DernièreAction = Val(Mid(Cells(DL, "A"), 3)) + 1                        ' Extrait le N° de la dernière action
    If Left(Cells(DL, "A"), 2) <> Right(Year(Now), 2) Then DernièreAction = 1 ' Si nouvelle année on repart à 1
    NouvelleAction = Right(Year(Now), 2) & Format(DernièreAction, "000")    ' Ajoute sur 2 digit l'année en cours
    Cells(1 + DL, "A") = NouvelleAction          ' L'écrit dans la pemière cellule vide de A
End Sub

chris

XLDnaute Barbatruc
RE

Effectivement si le tableau est totalement vide il y a un PB

Il faut inverser une ligne
VB:
Sub Inserer_Ligne()

Dim NL As Long, ColN As Range, X As Long

    With Range("Liste").ListObject
        NL = Range("Liste").ListObject.ListRows.Add.Index
        Set ColN = .ListColumns("Rapport").DataBodyRange
        If WorksheetFunction.Max(ColN) > (Year(Date) Mod 2000) * 1000 Then
            X = WorksheetFunction.MaxIfs(ColN, ColN, ">" & 2000 + Year(Date) Mod 2000)
        Else
            X = (Year(Date) Mod 2000) * 1000
        End If
        .ListColumns("Rapport").DataBodyRange.Cells(NL, 1) = X + 1
    End With

End Sub
Si tu ne colores pas manuellement la ligne des titres mais utilise le style de tableau orangé, cela suffit.

Sinon l'insertion d'une 1ère ligne reprend la couleur des titres et il faut ajouter une ligne pour corriger cette coloration.
Code:
Sub Inserer_Ligne()

Dim NL As Long, ColN As Range, X As Long

    With Range("Liste").ListObject
        NL = Range("Liste").ListObject.ListRows.Add.Index
        If NL = 1 Then .ListRows(1).Range.Interior.Color = xlNone
        Set ColN = .ListColumns("Rapport").DataBodyRange
        If WorksheetFunction.Max(ColN) > (Year(Date) Mod 2000) * 1000 Then
            X = WorksheetFunction.MaxIfs(ColN, ColN, ">" & 2000 + Year(Date) Mod 2000)
        Else
            X = (Year(Date) Mod 2000) * 1000
        End If
        .ListColumns("Rapport").DataBodyRange.Cells(NL, 1) = X + 1
    End With

End Sub
 

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonjour à toute & à tous, bonjour @viviepat
Comme d'habitude, le temps de boire un café, et de réfléchir, il y a déjà une flopée de réponses.
J'ai changé le nom des tableaux, homogénéisé la formule en colonne O, supprimé la formule en colonne A, créé un nom _An qui stocke l'année en cours et fait 2 macros, l'une pour ajouter une ligne l'autre pour changer d'année et insérer la 1ère ligne.
La formule en O
VB:
=SI(([@Réalisation]="")+([@Statut]="");"";CHOISIR(EQUIV([@Statut];_Tb_Statut;0);"Att. Valid.";"Accepté";"Refusé"))
le nom défini :
_An=22
La macro d'insertion :
Code:
Sub Inserer_ligne()
'Insére une nouvelle ligne

     With ThisWorkbook.Worksheets("Liste")
          DerNum = WorksheetFunction.Max(.ListObjects(1).ListColumns(1).Range)
          .ListObjects(1).ListRows.Add AlwaysInsert:=True
          DerNum = IIf(CStr(DerNum) Like [_An] & "###", DerNum + 1, CLng([_An] & "001"))
          .Cells(Rows.Count, 1).End(xlUp).Value = DerNum
     End With
   
End Sub
La macro de changement d'année
Code:
Sub inserer_ligne_Nouvelle_Année()
'Change l'année et insére une nouvelle ligne

     ThisWorkbook.Names("_An").Value = [_An] + 1
     Inserer_ligne
   
End Sub

Voir le fichier joint
Amicalement
Alain
 

Pièces jointes

  • Insérer les 2 derniers chiffre de l'année en cours.xlsm
    35.4 KB · Affichages: 1
Dernière édition:

AtTheOne

XLDnaute Impliqué
Supporter XLD
Re-bonjour
Avec le cas où le tableau ne comporte qu'une ligne sans N° de rapport :
Code:
Sub Inserer_ligne()
'Insére une nouvelle ligne

     With ThisWorkbook.Worksheets("Liste")
          'Récupération du dernier n°
          DerNum = WorksheetFunction.Max(.ListObjects(1).ListColumns(1).Range)
          'Si la dernière cellule n'est pas vide on ajoute une ligne
          If .Cells(Rows.Count, 1).End(xlUp).Value <> "" Then .ListObjects(1).ListRows.Add AlwaysInsert:=True
          'Nouveau n°
          DerNum = IIf(CStr(DerNum) Like [_An] & "###", DerNum + 1, CLng([_An] & "001"))
          .Cells(Rows.Count, 1).End(xlUp).Value = DerNum
     End With
    
End Sub

J'ai préféré conserver le principe d'un bouton pour le changement d'année au cas où il y aurait des rapports de la fin de l'année précédente à saisir en début d'année ...

Amicalement
Alain
 

Pièces jointes

  • Insérer les 2 derniers chiffre de l'année en cours 2.xlsm
    34.5 KB · Affichages: 1

Discussions similaires

Statistiques des forums

Discussions
312 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16