ajoute de feuille + colorier automatiquement une cellule

[Guy55]

Bonjour au Forum

Comment faire colorier automatiquement la cellule de la colonne A si la feuille existe ?
Si j'ajoute des noms dans la colonne A, les feuilles existantes doivent rester en couleur et les nouvelles cellules de la colonne A ne le seront pas tant qu'il n'y aura pas de feuille a leur nom.
J'ai colorier ma solution plus bas mais j'ai pas de résultat
Merci a tout le monde

Sub AjouterFeuille()
On Error GoTo FinAjout
Dim c As Range, cel As Range
Dim plg As Range
Dim sh As Worksheet
Dim X As Range
On Error GoTo FinAjout
Application.ScreenUpdating = False
For Each c In Feuil1.Range("A5:A" & Sheets("Menu").Range("A65536").End(xlUp).Row)
If Not IsEmpty(c) Then
If Not ExisteFeuille(c.Text) Then
Set sh = Worksheets.Add(After:=Sheets(Worksheets.Count))
sh.Name = c
' c = cel.Interior.ColorIndex = 30 'colorie la cellule en "bleu clair" quand la feuille existe
End If
With Sheets("masque")
.Visible = xlSheetVisible
.Select
End With
Cells.Copy
Sheets(Worksheets.Count).Select
Range("A1").Select
ActiveSheet.Paste
Range("D6").Value = ActiveSheet.Name
Application.CutCopyMode = False
Set X = Sheets("Menu").Cells.Find(What:=ActiveSheet.Name)
If Not X Is Nothing Then
With ActiveSheet
.Range("D6").Value = X
.Range("C16").Value = X.Offset(0, 2).Value
.Range("E3").Value = X.Offset(0, 3).Value
.Range("A9").Value = X.Offset(0, 1).Value
.Range("C24").Value = X.Offset(0, 10).Value
End With
Range("A1").Select
'caché la feuille masque apres création des feuilles
'Sheets("masque").Visible = xlSheetHidden
End If
End If
Next c
FinAjout:
Application.ScreenUpdating = True
End Sub

Function ExisteFeuille(NomFeuille As String) As Boolean
Dim sh As Worksheet
Application.Volatile
On Error Resume Next
Set sh = ThisWorkbook.Sheets(NomFeuille)
ExisteFeuille = Err.Number = 0
End Function

 

[THE CAT 2007]

Re : ajoute de feuille + colorier automatiquement une cellule

Bonsoir,

c = cel.Interior.ColorIndex = 30

2 égals çà fait surement 1 de trop ....

c.Interior.ColorIndex = 30 ?

et
Application.ScreenUpdating = False

en période de mise au point, il vaut mieux laisser sur true pour voir les résultats
et le passer à false quand tout est correct ...

 

[Guy55]

Re : ajoute de feuille + colorier automatiquement une cellule

Bonjour et merci thecat2007
c = cel.Interior.ColorIndex = 30 fonctionne bien dans d'autres applications.
J'aimerais juste savoir ou placer cette ligne dans mon pgm VBA pour colorier les cellules de la colonne A lorsque ou feuille portant le même nom existe
Merci
Guy

 

[THE CAT 2007]

Re : ajoute de feuille + colorier automatiquement une cellule

Bj,

ai changé :
For Each c In Sheets("Menu").Range("A5:A" & Sheets("Menu").Range("A65536").End(xlUp).Row)

afin de rester sur la feuille menu ..

Not ExisteFeuille(c.Value) renvoie tj faux -> d'où pas de création de feuille

essayer à la place du if :

Select Case Not ExisteFeuille(c.Value)
  Case Is = False ' ou true suivant debug
   Set sh = Worksheets.Add(After:=Sheets(Worksheets.Count))
    sh.Name = c
      
 Case Is = True ' ou false suivant debug
      c.Interior.ColorIndex = 30
End Select