[RÉSOLU) Ecrire 2019 en couleur par macro

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

un internaute

XLDnaute Impliqué
Bonjour le forum
Dans la macro ci-dessous j'ai ajouté les lignes en rouge pour pouvoir faire passer 2019
Ça fonctionne bien sauf que je n'ai pas 2019 en rouge (Montant Eau chaude année 2019)
Quelqu'un a t-il une idée où ça bloque?
Merci pour vos retours.
Cordialement


Code:
Sub NouvelleAnnee()
Dim NomFeuille As String
Dim An As Integer
Dim Couleur
Dim Sh As Shape

  Couleur = Array(3, 4, 5, 6, 7, 8, 9, 10, 17, 40, 49, 42)
  With ActiveSheet
    An = Val(Split(.Name, " ")(1))
    If An = 0 Then
      MsgBox "Nom de la feuille non conforme"
      Exit Sub
    End If
    .Unprotect
    NomFeuille = "Charges " & An + 1

    .Copy after:=Sheets(Sheets.Count)
    '.Shapes("AnneePlus").Delete     'Mettre en commentaires pour ne pas effacer le bouton (nouvelle année)de la Feuille Précédente
    .Protect
  End With
  With ActiveSheet
    .Name = NomFeuille
    .Tab.ColorIndex = Couleur((An - 2000) Mod 12)
    .Range("E5:E6,A10:C14,E10:E14,A16:C27,E16:E27,A38:C42,E38:E42,A44:C55,E44:E55,A66:C70,E66:E70,A72:C83,E72:E83,A94:C98,E94:E98,A100:C111,E100:E111,F7,F35,F63,F91,G7:I7,G17:I21,I27,G23:I27,G46:I49,G51:I55,G73:I77,G79:I83,G101:I105,G107:I111,G117:I117,G119:I119").ClearContents
    .Cells.Replace What:=An, Replacement:=An + 1
     For Each Sh In .Shapes
       If Sh.TopLeftCell.Column = 2 Then     '2 = Colonne B
        With Sh.TextFrame.Characters(Start:=127, Length:=4)
          .Insert An + 1         ' Incrémentation d'un an
          .Font.ColorIndex = 3   ' Couleur année
          .Font.Size = 20        ' Taille texte
        End With
        Exit For
      End If
    Next Sh
         For Each Sh In .Shapes
       If Sh.TopLeftCell.Column = 7 Then     '7 = Colonne G
        With Sh.TextFrame.Characters(Start:=18, Length:=4)
        With Sh.TextFrame.Characters(Start:=26, Length:=4)
          .Insert An + 1         ' Incrémentation d'un an
          .Font.ColorIndex = 3   ' Couleur année
          .Font.Size = 20        ' Taille texte
        End With
        End With
        Exit For
      End If
    Next Sh
        
  .Range("A1").Select
  End With
End Sub
 
Re-bonjour le forum
Ajout de la ligne en rouge
Merci
Bonne fin de journée
Cordialement

Code:
Option Explicit

Sub NouvelleAnnee()
Dim NomFeuille As String
Dim An As Integer
Dim Couleur
Dim Sh As Shape

  Couleur = Array(3, 4, 5, 6, 7, 8, 9, 10, 17, 40, 49, 42)
  With ActiveSheet
    An = Val(Split(.Name, " ")(1))
    If An = 0 Then
      MsgBox "Nom de la feuille non conforme"
      Exit Sub
    End If
    .Unprotect
    NomFeuille = "Charges " & An + 1

    .Copy after:=Sheets(Sheets.Count)
    '.Shapes("AnneePlus").Delete
    .Protect
  End With
  With ActiveSheet
    .Name = NomFeuille
    .Tab.ColorIndex = Couleur((An - 2000) Mod 12)
    .Range("E5:E6,A10:C14,E10:E14,A16:C27,E16:E27,A38:C42,E38:E42,A44:C55,E44:E55,A66:C70,E66:E70,A72:C83,E72:E83,A94:C98,E94:E98,A100:C111,E100:E111,F7,F35,F63,F91,G7:I7,G17:I21,I27,G23:I27,G46:I49,G51:I55,G73:I77,G79:I83,G101:I105,G107:I111,G117:I117,G119:I119").ClearContents
    '.Range("E5:E6,A10:C14,E10:E14,A16:C27,E16:E27,A38:C42,E38:E42,A44:C55,E44:E55,A66:C70,E66:E70,A72:C83,E72:E83,A94:C98,E94:E98,A100:C111,E100:E111,F7,F35,F63,F91,G7:I7,G17:I21,I27,G23:I27,G45:I49,G51:I55,G73:I77,G79:I83,G101:I105,G107:I111,G117:I117,G119:I119").Interior.ColorIndex = 8
    'La ligne ci-dessous permer d'ajouter 1 année de plus dans la feuille excel.Cellules A1, A2,A22, A40, A58
    .Cells.Replace What:=An, Replacement:=An + 1
   
    .Range("G45").Characters(Start:=26, Length:=4).Font.ColorIndex = 3
   
      For Each Sh In .Shapes                  '
  
       If Sh.TopLeftCell.Column = 2 Then     '2 = Colonne B
        With Sh.TextFrame.Characters(Start:=127, Length:=4)
          .Insert An + 1         ' Incrémentation d'un an
          .Font.ColorIndex = 3   ' Couleur année
          .Font.Size = 20        ' Taille texte
        End With
        Exit For
      End If
    Next Sh
         For Each Sh In .Shapes
       If Sh.TopLeftCell.Column = 7 Then     '7 = Colonne G
        With Sh.TextFrame.Characters(Start:=18, Length:=4)
          .Insert An + 1         ' Incrémentation d'un an
          .Font.ColorIndex = 3   ' Couleur année
          .Font.Size = 20        ' Taille texte
        End With
        Exit For
      End If
    Next Sh
      
  .Range("A1").Select
  End With
End Sub

Sub NouvelleAnneeOLd()        'OLd pour différencier cette Macro avec la précédente
Dim NomFeuille As String
Dim An As Integer
Dim Couleur
Dim Sh As Shape

  Couleur = Array(3, 4, 5, 6, 7, 8, 9, 10, 17, 40, 49, 42)
  With ActiveSheet
    An = Val(Split(.Name, " ")(1))
    If An = 0 Then
      MsgBox "Nom de la feuille non conforme"
      Exit Sub
    End If
    .Unprotect
    NomFeuille = "Charges " & An + 1 'Espace après Charges affiche Charges 2014.Supprimer Espace affiche par exemple Charges2014

    .Copy after:=Sheets(Sheets.Count)
    '.Shapes("AnneePlus").Delete     'Mettre en commentaires pour ne pas effacer le bouton (nouvelle année)de la Feuille Précédente
    .Protect
  End With
  With ActiveSheet
    .Name = NomFeuille
    .Tab.ColorIndex = Couleur((An - 2000) Mod 12)
    .Range("E5:E6,A10:C14,E10:E14,A16:C27,E16:E27,A38:C42,E38:E42,A44:C55,E44:E55,A66:C70,E66:E70,A72:C83,E72:E83,A94:C98,E94:E98,A100:C111,E100:E111,F7,F35,F63,F91,G7:I7,G17:I21,I27,G23:I27,G46:I49,G51:I55,G73:I77,G79:I83,G101:I105,G107:I111,G117:I117,G119:I119").ClearContents
    '.Range("E5:E6,A10:C14,E10:E14,A16:C27,E16:E27,A38:C42,E38:E42,A44:C55,E44:E55,A66:C70,E66:E70,A72:C83,E72:E83,A94:C98,E94:E98,A100:C111,E100:E111,F7,F35,F63,F91,G7:I7,G17:I21,I27,G23:I27,G45:I49,G51:I55,G73:I77,G79:I83,G101:I105,G107:I111,G117:I117,G119:I119").Interior.ColorIndex = 8
    'La ligne ci-dessous permer d'ajouter 1 année de plus dans la feuille excel.Cellules A1, A2,A22, A40, A58
    .Cells.Replace What:=An, Replacement:=An + 1          'Cette ligne pour modifier l'Année dans TOUTES les CELLULES de la Feuille Excel.Exemple => 2015 par 2016
  
     .Range("G45").Characters(Start:=26, Length:=4).Font.ColorIndex = 3  'Pour afficher 2019 en rouge couleur
  
     For Each Sh In .Shapes                  'Ces 10 lignes pour ajouter une année soit par exemple 2017 à la place de 2016 dans Bouton macro Afficher / Masquer
       If Sh.TopLeftCell.Column = 2 Then     '2 = Colonne B
        With Sh.TextFrame.Characters(Start:=127, Length:=4)   'Pour obtenir les nombres 145 & 4 faire: OUTILS => MACRO => NOUVELLE MACRO et les extraire de cette ligne dans la macro1:  With Selection.Characters(Start:=145, Length:=4).Font. Mettre Sh.TextFrame à la place de Selection
          .Insert An + 1         ' Incrémentation d'un an
          .Font.ColorIndex = 3   ' Couleur année
          .Font.Size = 20        ' Taille texte
        End With
        Exit For
      End If
    Next Sh
             For Each Sh In .Shapes                  'Ces 10 lignes pour ajouter une année soit par exemple 2017 à la place de 2016 dans Bouton macro Afficher / Masquer
       If Sh.TopLeftCell.Column = 7 Then     '7 = Colonne G
        With Sh.TextFrame.Characters(Start:=18, Length:=4)   'Pour obtenir les nombres 145 & 4 faire: OUTILS => MACRO => NOUVELLE MACRO et les extraire de cette ligne dans la macro1:  With Selection.Characters(Start:=145, Length:=4).Font. Mettre Sh.TextFrame à la place de Selection
          .Insert An + 1         ' Incrémentation d'un an
          .Font.ColorIndex = 3   ' Couleur année
          .Font.Size = 20        ' Taille texte
        End With
        Exit For
      End If
    Next Sh

    .Range("A1").Select
  End With
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour