Modifications macro

Le 05/07/2018 à 16:26

Bonjour le forum

Lorsque je crée une nouvelle Année et si cette Nouvelle Année existe déjà la macro dit ceci: Feuille existe Charges 2019

Je n'arrive pas à faire dire à la macro "La feuille Charges 2019 existe déjà"

Quelqu'un aurait-il une idée?

Merci d'avance pour vos retours

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

Application.ScreenUpdating = False
  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
        If FeuilleExiste(NomFeuille) = True Then
      MsgBox "Feuille existe " & NomFeuille
      Exit Sub
    End If
   .Unprotect
    .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)
    On Error Resume Next
    .Range("E5:E6,A10:C14,E10:E14,A16:C29,E16:E29,A40:C44,E40:E44,A46:C59,E46:E59,A70:C74,E70:E74,A76:C89,E76:E89,A100:C104,E100:E104,A106:C119,E106:E119,F7,F37,F67,F97,G7:I7,G17:I22,G24:I29,G48:I52,G55:I59,G76:I82,G84:I89,G108:I112,G114:I119,G125:I125,G127:I127").SpecialCells(xlCellTypeConstants, 23).ClearContents
    On Error GoTo 0
    '.Range("E5:E6,A10:C14,E10:E14,A16:C29,E16:E29,A40:C44,E40:E44,A46:C59,E46:E59,A70:C74,E70:E74,A76:C89,E76:E89,A100:C104,E100:E104,A106:C119,E106:E119,F7,F37,F67,F97,G7:I7,G17:I22,G24:I29,G48:I52,G55:I59,G77:I82,G84:I89,G108:I112,G114:I119,G125:I125,G127:I127").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

      With .[A1]
     .Characters(Start:=1, Length:=13).Font.ColorIndex = 5
     .Characters(Start:=14, Length:=1).Font.ColorIndex = 15
    .Characters(Start:=15, Length:=4).Font.ColorIndex = 3
    End With

     .Cells.Replace What:=An, Replacement:=An + 1        '1ère phase on augmente de 1 l'année supérieure
     .Cells.Replace What:=An - 1, Replacement:=An        '2ème phase on augmente de 1 l'année inférieure

     .[A5].Characters(Start:=7, Length:=7).Font.ColorIndex = 3
     .[A5].Characters(Start:=18, Length:=16).Font.ColorIndex = 3

     .[A6].Characters(Start:=7, Length:=7).Font.ColorIndex = 5
     .[A6].Characters(Start:=18, Length:=16).Font.ColorIndex = 5

     .[G46].Characters(Start:=18, Length:=16).Font.ColorIndex = 3

     .[G47].Characters(Start:=26, Length:=4).Font.ColorIndex = 3
     .[G47].Characters(Start:=41, Length:=2).Font.ColorIndex = 3

     .[G53].Characters(Start:=26, Length:=4).Font.ColorIndex = 3
     .[G53].Characters(Start:=41, Length:=2).Font.ColorIndex = 3

     .[G54].Characters(Start:=18, Length:=18).Font.ColorIndex = 3
     .[G54].Characters(Start:=57, Length:=6).Font.ColorIndex = 3

     For Each Sh In .Shapes
       If Sh.TopLeftCell.Column = 2 Then
        With Sh.TextFrame.Characters(Start:=15, Length:=4)
          .Insert An + 1
          .Font.ColorIndex = 3
          .Font.Size = 20
        End With
        Exit For
      End If
    Next Sh
         For Each Sh In .Shapes
       If Sh.TopLeftCell.Column = 7 Then
        With Sh.TextFrame.Characters(Start:=18, Length:=4)
          .Insert An + 1
          .Font.ColorIndex = 3
          .Font.Size = 20
        End With
        Exit For
      End If
    Next Sh

  .[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

Application.ScreenUpdating = False
  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)
    On Error Resume Next
    .Range("E5:E6,A10:C14,E10:E14,A16:C29,E16:E29,A40:C44,E40:E44,A46:C59,E46:E59,A70:C74,E70:E74,A76:C89,E76:E89,A100:C104,E100:E104,A106:C119,E106:E119,F7,F37,F67,F97,G7:I7,G17:I22,G24:I29,G48:I52,G55:I59,G76:I82,G84:I89,G108:I112,G114:I119,G125:I125,G127:I127").SpecialCells(xlCellTypeConstants, 23).ClearContents
    On Error GoTo 0
    '.Range("E5:E6,A10:C14,E10:E14,A16:C29,E16:E29,A40:C44,E40:E44,A46:C59,E46:E59,A70:C74,E70:E74,A76:C89,E76:E89,A100:C104,E100:E104,A106:C119,E106:E119,F7,F37,F67,F97,G7:I7,G17:I22,G24:I29,G48:I52,G55:I59,G77:I82,G84:I89,G108:I112,G114:I119,G125:I125,G127:I127").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

      With .Range("A1")
     .Characters(Start:=14, Length:=5).Font.ColorIndex = 3
     .Characters(Start:=14, Length:=1).Font.ColorIndex = 15
     End With

     .Cells.Replace What:=An, Replacement:=An + 1        '1ère phase on augmente de 1 l'année supérieure
     .Cells.Replace What:=An - 1, Replacement:=An        '2ème phase on augmente de 1 l'année inférieure

     With .Range("A5")
     .Characters(Start:=7, Length:=7).Font.ColorIndex = 3
     .Characters(Start:=18, Length:=16).Font.ColorIndex = 3
      End With

      With .Range("A6")
     .Characters(Start:=7, Length:=7).Font.ColorIndex = 5
     .Characters(Start:=18, Length:=16).Font.ColorIndex = 5
      End With

      With .Range("G46")
     .Characters(Start:=18, Length:=16).Font.ColorIndex = 3
      End With

      With .Range("G47")
     .Characters(Start:=26, Length:=4).Font.ColorIndex = 3
     .Characters(Start:=41, Length:=2).Font.ColorIndex = 3
      End With

      With .Range("G53")
     .Characters(Start:=26, Length:=4).Font.ColorIndex = 3
     .Characters(Start:=41, Length:=2).Font.ColorIndex = 3
      End With

      With .Range("G54")
     .Characters(Start:=18, Length:=18).Font.ColorIndex = 3
     .Characters(Start:=57, Length:=6).Font.ColorIndex = 3
      End With

     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 127 & 4 faire: OUTILS => MACRO => NOUVELLE MACRO et les extraire de cette ligne dans la macro1:  With Selection.Characters(Start:=127, 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 18 & 4 faire: OUTILS => MACRO => NOUVELLE MACRO et les extraire de cette ligne dans la macro1:  With Selection.Characters(Start:=18, 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

  .[A1].Select
  End With
Application.ScreenUpdating = True
End Sub
Le 05/07/2018 à 18:54

Salut,

A première vue c'est au niveau de :

MsgBox "Feuille existe " & NomFeuille  qui renvoie en message l’information dont tu parles, il faudrait donc faire

Tu remplaces par:

MsgBox "La feuille " & NomFeuille & " existe déjà "

Si tu veux plus d'explication n'hésite pas

ECG

Le 05/07/2018 à 18:59

Bonsoir ExcelCoreGame

J'ai testé c'est exactement ça.

Merci à toi et bonne fin de soirée

Bien cordialement

Rechercher des sujets similaires à "modifications macro"