Colorier les dates des mois pairs en VBA uniquement

Résolu/Fermé
fredounette - 10 déc. 2015 à 09:02
 fredounette - 10 déc. 2015 à 10:32
Bonjour,

Je vous remercie d'avance pour votre précieuse aide :-)

J'ai un tableau (sorte de planning) sur 3 ans que l'utilisateur doit pouvoir venir colorier pour indiquer des absences spécifiques. Afin de mieux distinguer les dates je voulais colorier les dates correspondants aux mois pairs. Je ne peux pas le faire via la mise en forme conditionnelle puisque la couleur de la MFC passe au-dessus du coloriage qui sera fait par l'utilisateur.
Il me faut donc recourir à une macro. J'ai essayé ceci sans succès :

Sub couleur_mois_pair()

Dim Mois As Integer
Mois = Month(ActiveCell)


Range("a8:bb38").Select
For Each cell In Selection
If ActiveCell.Value = Application.WorksheetFunction.Even(Mois) Then
ActiveCell.Interior.ColorIndex = 3
End If
Next


End Sub

Pour la suite, si qqn a une idée géniale ^^, j'aimerais, toujours en vba, trouver la date la plus récente coloriée en code couleur 39 (car j'ai une fonction qui compte le nombre de cellule mises en code couleur 39). Je dois pouvoir ensuite compter les jours restant en diminuant la valeur que j'ai trouvé avec ma fonction.

exemple : j'ai colorié 65 cases (ma fonction me retourne 65) et, à partir de la date la plus récente, je dois simuler la date qui correspond au 180ème jours à partir de la date la plus récente (180-65).

Un énorme merci d'avance à vos contributions



1 réponse

f894009
Messages postés
16647
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
16 août 2022
1 648
10 déc. 2015 à 10:12
Bonjour,

Sub couleur_mois_pair()
    Dim Mois As Integer, Plage As Range
    
    Application.ScreenUpdating = False
    Set Plage = Worksheets("feuil1").Range("a8:bb38")   'mise en memoire plage de cellules
    For Each Cell In Plage
        If Month(Cell) Mod 2 Then   'test si pair
            Cell.Interior.ColorIndex = 3
        End If
    Next Cell
    Application.ScreenUpdating = True
End Sub
0
Trop fort.... ça marche du tonnerre.... Mille mercis, c'est génial...

bonne journée
0