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
Bonjour

Pour qu'une formule se propage il faut qu'elle soit homogène de la 1ère à la dernière ligne donc supprime la ligne 4 et remplace la formule en 1ère colonne par
VB:
=SI([@Objet]="";"";SI(LIGNE()=4;22000;MAX($A$3:A3)+1))

Pas vu de formule dans une autre colonne
 

Patoche42

XLDnaute Junior
Merci Chris pour ton retour,
effectivement ta formule fonctionne parfaitement.
L'autre formule se trouve en O47.
Par contre lorsque j'arrive sur un changement d'année ça coince.
A savoir que pour ma part je serais faire le changement d'année en retravaillant la formule mais je ne suis pas le seul à me servir du fichier.
 

chris

XLDnaute Barbatruc
RE

Même remarque : une unique formule dans une colonne est contraire aux règles des tableaux structurés et risque d'entraîner des PB

Soit cette colonne est saisie soit elle est formulée et il faut donc les règles des autres valeurs

Si tu enchaîne les années il faut écrire le N° en VBA pour chaque ligne, une formule ne peut de façon homogène se référer à des années différentes...
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Viviepat, Chris,
La macro ci dessous met la nouvelle action dans la première cellule vide de la colonne A:
VB:
Sub InsererDateEtHeure()
    Dim DernièreAction%, NouvelleAction$
    DernièreAction = Val(Mid(Application.Max([A:A]), 3)) + 1                ' Extrait le N° de la dernière action               '
    NouvelleAction = Right(Year(Now), 2) & Right("0" & DernièreAction, 3)  ' Ajoute sur 2 digit l'année en cours
    Cells(1 + Range("A65500").End(xlUp).Row, "A") = NouvelleAction          ' L'écrit dans la pemière cellule vide de A
End Sub
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

On manipule un tableau structuré donc il est préférable de coder en TS (et cela fait 14 ans qu'on a plus de 65000 lignes dans Excel).

Utiliser les références Tableau structuré permettent de ne s'occuper ni de l'onglet où il se trouve, ni de sa position sur l'onglet, ni de l'ordre des colonnes ce qui permet de faire évalouer le tableau sans modifier le code.

Avec un tableau nommé correctement, Liste par exemple
VB:
Sub Inserer_Ligne(Optional An As Integer)

Dim NL As Long, ColN As Range

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

End Sub

Sub Inserer_LigneAnnee()

Dim ColN As Range
            
    Set ColN = Range("Liste").ListObject.ListColumns("Rapport").DataBodyRange

    If WorksheetFunction.Max(ColN) > (Year(Date) Mod 2000) * 1000 Then
        MsgBox "Année déjà en cours"
    Else
        Inserer_Ligne (Year(Date))
    End If

End Sub
 
Dernière édition:

chris

XLDnaute Barbatruc
RE

Comme je l'ai dit il faut nommer le tableau : on ne garde pas les noms automatiques de type Tableau1, pas plus qu'on de garde Feuil1 ou Classeur1...

J'avais conservé ton principe de 2 boutons...

Voici avec un bouton. J'ai aussi corrigé ton code de valorisation de la colonne réalisation
 

Pièces jointes

  • NEW Gestion Rapport3.xlsm
    23.5 KB · Affichages: 3

Patoche42

XLDnaute Junior
Merci Chris d'avoir pris de ton temps,
Je pense que je vais refaire le fichier en suivant tes conseils (c'est vrai que c'est le fouillis dans gestion des noms).
Par contre j'ai un message d'erreur quand je clique une 2ème fois pour insérer une ligne.
J'ai essayé de décrypter ton code, j'en ai compris une partie mais je ne vois pas ce qui cloche.
 

Discussions similaires

Réponses
4
Affichages
76