[RÉSOLU] Ajouter 1 an aux commentaires

[un internaute]

Bonjour le forum
Quelqu'un a fait ça l'autre jour
Peut-on l'adapter en lui faisant ajouter 1 an lorsque je passe en 2019?
Décembre 2017 deviendra donc Décembre 2018
Mes commentaires cellule A2 sont les suivants avec ces couleurs et sur 2 lignes:
Rappel consommation
Décembre 2017
Bien cordialement

Option Explicit
Sub CopieCommentaires()
Dim R As Worksheet 'déclare la variable R (onglet de Référence)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TC As String 'déclare la variable TC (Texte du Commentaire)

  Set R = Worksheets("Année 2018") 'définit l'onglet de référence R (celui où il y a le commentaire, à adapter)
  On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
  TC = R.Range("A2").Comment.Text 'définit le texte du commentaire TC (génère une erreur si A3 ne contient pas de commentaire)
  If Err <> 0 Then 'condition : si une erreur a été générée
     MsgBox "il n'y a pas de commentaire ! Action terminée." 'message
     Exit Sub 'sort de la procédure
  End If 'fin de la condition
  MsgBox "commentaire à copier :  " & TC
  Application.EnableEvents = False
  For Each O In Worksheets 'boucle sur tous les onglets O du classseur
     If O.Name <> R.Name Then 'condition : si le nom de l'onglet O est différent du nom de l'onget de référence R
       R.Range("A2").Copy O.Range("A2")
     End If 'fin de le condition
  Next O 'prochain onglet de la boucle
  Application.EnableEvents = True
End Sub

 

[Robert]

Bonjour un internaute, bonjour le forum,

Pas sûr d'avoir bien compris mais remplace :

Set R = Worksheets("Année 2018") 'définit l'onglet de référence R (celui où il y a le commentaire, à adapter)

par :

Set R = Worksheets("Année " & Year(Date))

Ha, je crois connaître ce "quelqu'un"...

 

[un internaute]

Bonjour Robert,
Fait mais fait rien
A voir
Merci à toi

 

[Robert]

Re,

Fera qu'en 2019. Toi pas parler plus, moi me taire aussi... Les boules d'avoir perdu mon temps à te commenter le code.

 

[un internaute]

Bonsoir Robert
Pour que tu n'es plus les boules!!!
Me voilà avec des modifs pour faire passer les commentaires à une année de plus
Mais pas comme je veux.
Commentaires cellule A2 et F2
Si on fait Nouvelle Année les commentaires passent bien en 2018 pour cellule A2 (actuellement 2017) et 2019 pour cellule F2 (actuellement 2018), mais je ne retrouve pas mes couleurs
La macro est AjoutAnnee
Est-ce possible?
Je suis en excel 2003
Bien cordialement
Fichier joint

 

[Lone-wolf]

Bonsoir un internaute, Robert

@un internaute

À mon avis, il faut mettre le paramétrage des commentaires dans

Private Sub Workbook_NewSheet(ByVal Sh As Object)

With Sh
.Range("a2").Comment

.Range("f2").Comment

End With
End Sub

Ou dans Workbook_SheetActivate

 

[un internaute]

Bonsoir Lone-wolf
Merci pour ton retour
Tu as essayé de le faire "tourner" le fichier pour voir?
Cordialement

 

[Lone-wolf]

Re

@un internaute

Oui, mais sans ajouter la macro comme je l'ai dit.

 

[eriiic]

Bonjour,

tiens, quelqu'un a le même problème que toi : https://forum.excel-pratique.com/viewtopic.php?f=2&t=111428
eric

 

[un internaute]

Bonjour eriiiic
Evidemment que c'est le même problème car c'est moi
Je sais que que vous êtes sur plusieurs forum et c'est tant mieux car on appprend de tout le monde.
Je passe à résolu
Merci à tous et bon WE
Cordialement

 

[Lone-wolf]

Bonjour un internaute, eriiiic, Robert, le Forum

@un internaute

Je passe à résolu

Tu es sûr de ton coup? Crée la feuille 2020 et tu verra si tu as résolu le problème.
Quelles années sont inscritent dans les commentaires?!

 

[un internaute]

Bonjour Lone-wolf
P$$$$N!!!! tu as raison!!!
Bien vu
Alors là à toi de jouer.
Merci Lone-wolf
Cordialement

 

[Lone-wolf]

Bonsoir tout le monde, le Forum

@un internaute

Bien vu. Alors là à toi de jouer.

Désolé, je pense que Robert est mieux placé pour ça.

 

[un internaute]

@Lone-wolf
Voilà et ce n'est pas de moi.
Merci à vous tous pour vos retours TOUJOURS instructifs pour moi.
Bonne soirée à tous
Cordialement

Option Explicit

Sub NouvelleAnnee()
  Dim Couleur, cel As Range, p As Byte, An0%, An1%, An2%
  If [A2].Comment Is Nothing Then
    MsgBox "il n'y a pas de commentaire ! Action terminée.": Exit Sub
  End If
  Couleur = Array(3, 5, 43, 6, 7, 33, 29, 27, 38, 46, 26, 6)
  Const plg1 As String * 27 = "A1, G1, B2, D2, H2, G16, J2"
  Const plg2 As String * 18 = "C2, D2, G2, J2, A3"
  Application.ScreenUpdating = False
  An1 = Val(Split(ActiveSheet.Name, " ")(1))
  If An1 = 0 Then MsgBox "Nom de la Feuille non Conforme": Exit Sub
  ActiveSheet.Copy , Sheets(Sheets.Count): An0 = An1 - 1: An2 = An1 + 1
  On Error GoTo ErrNomFeuille     'ça arrive si le nouveau nom existe déjà
  With ActiveSheet                'onglet de la NOUVELLE année
    .Unprotect: .Name = "Année " & An2
    .Tab.ColorIndex = Couleur((An2 - 2000) Mod 12)
  End With
  With [E3]
    .Formula = "='Année " & An1 & "'!E15": .Locked = -1: .FormulaHidden = -1
  End With
  For Each cel In Range(plg1)
    p = InStr(cel.Value, An1): cel.Characters(p, 4).Text = An2
  Next cel
  If Not [F2].Comment Is Nothing Then _
    [F2].Comment.Shape.TextFrame.Characters(35, 4).Text = An2
  For Each cel In Range(plg2)
    p = InStr(cel.Value, An0): cel.Characters(p, 4).Text = An1
  Next cel
  [A2].Comment.Shape.TextFrame.Characters(31, 4).Text = An1
  'attention : mettre en commentaire pour ne pas effacer
  'le bouton "nouvelle année" de la Feuille Précédente
  'ActiveSheet.Shapes("AnneePlus").Delete
  Range("E4:F15, H4:I15").ClearContents: [A1].Select
  ActiveSheet.Protect: Exit Sub
ErrNomFeuille:
  MsgBox "La feuille Année " & An2 & " existe déjà."
End Sub

 

[Lone-wolf]

Re

@un internaute

Donc, problème résolu ou pas?? Sinon voici comment moi j'ai fait (Exemple). Clique sur la croix pour créer une nouvelle année.