Colorier automatiquement des cellules

[hebus30]

Bonjour,

J'ai trouvé une feuille excel sur ce forum (je ne me souviens plus du nom du fichier d'origine et j'ai changé le nom depuis ).
Cette feuille permet de gérer les demandes de congé en générant un calendrier mois par mois. Lors de la génération du calendrier, la colonne du dimanche est surlignée en verte et celles des jours fériés sont surlignées en orange.
Le tout est géré par une macro VB je pense dont voici une copie :

Sub auto_open()
On Error Resume Next
Application.CommandBars("BarreColoriage").Delete
CommandBars.Add ("BarreColoriage")
CommandBars("BarreColoriage").Visible = True
For i = 1 To Application.CountA([MesCouleurs]) + 1
Set bouton = CommandBars("BarreColoriage").Controls.Add(Type:=msoControlButton)
bouton.Style = msoButtonCaption
bouton.Tag = Range("MotifsCongés")(i)
bouton.OnAction = "'Coloriage """ & i & """'"
bouton.Caption = Range("MesCouleurs")(i)
Next i
End Sub
Sub Coloriage(p)
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For Each c In Selection
c.Value = Range("MesCouleurs")(p).Value
' C.Interior.ColorIndex = Range("MesCouleurs")(p).Interior.ColorIndex
Range("MesCouleurs")(p).Copy c
If Range("MotifsCongés")(p) <> "" Then
If c.Comment Is Nothing Then c.AddComment ' Création commentaire
c.Comment.Shape.OLEFormat.Object.Font.Name = "Tverdana"
c.Comment.Shape.OLEFormat.Object.Font.Size = 7
c.Comment.Shape.OLEFormat.Object.Font.FontStyle = "Normal"
temp = Range("MotifsCongés")(p)
c.Comment.Text Text:=temp
c.Comment.Shape.TextFrame.AutoSize = True
c.Comment.Visible = False
Else
c.ClearComments
End If
Next c
Application.Calculation = xlCalculationAutomatic
End Sub
Sub auto_close()
On Error Resume Next
Application.CommandBars("BarreColoriage").Delete
End Sub

Pourrais t'on m'expliquer comment ça fonctionne? j'aimerais ajouter le samedi en surlignage vert.

 

[fhoest]

Re : Colorier automatiquement des cellules

Bonjour,
je pense que ton fichier serai utile car a mon avis il manque du code quelque part (appel des sub dans workbook_change ou feuill1 ou autre...
A+

 

[Gorfael]

Re : Colorier automatiquement des cellules

Salut hebus30, fhoest et le forum

Sub auto_open()
'Se lance à l'ouverture du classeur, mais syntaxe Excel5
'aujoud'hui : Private Sub Workbook_Open() sur module ThisWorkBook
On Error Resume Next
'en cas d'erreur continuer
Application.CommandBars("BarreColoriage").Delete
'effacer la barre d'outils BarreColoriage
CommandBars.Add ("BarreColoriage")
'ajouter la barre d'outils BarreColoriage
CommandBars("BarreColoriage").Visible = True
'la rendre visible
For i = 1 To Application.CountA([MesCouleurs]) + 1
'pour i = 1 à nombre de cellule non vide dans la plage "Mescouleurs" +1
    'aujoudhui : Application.WorksheetFunction.CountA
    Set bouton = CommandBars("BarreColoriage").Controls.Add(Type:=msoControlButton)
    'créer un bouton
    bouton.Style = msoButtonCaption
    bouton.Tag = Range("MotifsCongés")(i)
    'tag = ième cellule de Coloriage
    bouton.OnAction = "'Coloriage """ & i & """'"
    bouton.Caption = Range("MesCouleurs")(i)
    'légende = ième cellule de MesCouleurs
Next i
End Sub
Sub Coloriage(p)
Application.Calculation = xlCalculationManual
'Calcul sur manuel
Application.ScrenUpdating = False
For Each c In Selection
'Pour caque cellule de la sélection
    c.Value = Range("MesCouleurs")(p).Value
    'cellule=cellule pième de MesCouleurs
    ' C.Interior.ColorIndex = Range("MesCouleurs")(p).Interior.ColorIndex
    Range("MesCouleurs")(p).Copy c
    If Range("MotifsCongés")(p) <> "" Then
    'si cellule pième de MotifsCongés n'est pas vide, alors
        If c.Comment Is Nothing Then c.AddComment ' Création commentaire
        c.Comment.Shape.OLEFormat.Object.Font.Name = "Tverdana"
        c.Comment.Shape.OLEFormat.Object.Font.Size = 7
        c.Comment.Shape.OLEFormat.Object.Font.FontStyle = "Normal"
        temp = Range("MotifsCongés")(p)
        'temp = cellule pième de MotifsCongés
        c.Comment.Text Text:=temp
        c.Comment.Shape.TextFrame.AutoSize = True
        c.Comment.Visible = False
    Else 'si elle est vide
        c.ClearComments
        'effacer le commentaire
    End If
Next c
Application.Calculation = xlCalculationAutomatic
'remettre le calcul sur automatique
End Sub
Sub auto_close()
'idem => maintenant Workbook_BeforeClose
On Error Resume Next
Application.CommandBars("BarreColoriage").Delete
'effacer la barre d'outils BarreColoriage
End Sub

Le code fourni ne fait rien concernant le dimanche ou autre.
Pas assez de données pour aider, et de plus, c'est un vieux code.
A+