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

Patoche42 · 5 Avril 2022

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é)

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.

sylvanu · 6 Avril 2022

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 · 7 Avril 2022

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 · 7 Avril 2022

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

AtTheOne · 7 Avril 2022

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

Patoche42 · 8 Avril 2022

Merci à vous de vous être penchés sur mon problème.
Je vais retenir et appliquer beaucoup de vos conseils.
Je vais me pencher sur ces lignes de code pour bien comprendre tous ça.
Encore merci.

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

Patoche42

XLDnaute Junior

Pièces jointes

sylvanu

chris

XLDnaute Barbatruc

AtTheOne

XLDnaute Accro

Pièces jointes

AtTheOne

XLDnaute Accro

Pièces jointes

Patoche42

XLDnaute Junior

Discussions similaires