XL 2016 Couleur indiquant une valeur en minute - RESOLU-

[stef2872]

bonjour à tous !

J'ai créer un planning mensuel suivant des tutoriels qui m'ont permis de débuter avec les automatisations que peut proposer Excel (je suis loin d'avoir tout vu !)
A ce suhet , j'aurais souhaité savoir si il était possible qu'une couleur générée par la mise en forme conditionnelle et déclenchée par une macro puisse également indiquer une valeur en minute dans la cellule mise en surbrillance ?
A toutes fins utiles je vous joins mon fichier.
Merci à tous pour vos éclaircissements et conseils divers !

 

[Lolote83]

Salut STEF2872,
Peut être en inscivant des données dans tes cellules comme :
PR = Présence
CO = Congé
MA = Maladie
CF = CFA
Et ensuite faire la somme que l'on multiplie par 15 min
A voir
@+ Lolote83

 

[stef2872]

Lolote83,

Un grand merci à toi !
Je bûche la dessus depuis hier et ta solution est super !
Je n'aurais pas pensé du tout à modifier mes macro avec
With Selection
.Value = "PR " ou "CF"
Puis faire une sommeprod*15mn

Encore merci pour ton aide
Passe une excellente journée et de belles fêtes de fin d'année

 

[job75]

Bonjour stef2872, Lolote83,

On peut compter les cellules colorées, voyez le fichier joint.

Le code dans Module1 :

Function CompteCoul(ref As Range, r As Range)
Application.Volatile
Dim coul&
coul = ref.Interior.ColorIndex
For Each r In r
    If r.Interior.ColorIndex = coul Then CompteCoul = CompteCoul + 1
Next
End Function

Sub Couleur() 'macro affectée aux boutons
If IsError(Application.Caller) Then Exit Sub 'sécurité
Dim P As Range, jour As Range, base As Range, i As Variant, coul&, c As Range
Set P = [D10:AH63] 'à adapter
Set jour = [8:8] 'ligne à adapter
Set base = [E65:E68] 'à adapter
i = Application.Match(ActiveSheet.DrawingObjects(Application.Caller).Text, base, 0)
If IsError(i) Then coul = xlNone Else coul = base(i, 0).Interior.ColorIndex
ActiveCell.Activate 'si un objet est sélectionné
On Error Resume Next
For Each c In Selection
    If Intersect(c, P) Is Nothing Or Weekday(jour(c.Column)) = 1 Then Else c.Interior.ColorIndex = coul
Next
Calculate 'recalcule les formules volatiles
End Sub

Le code dans la feuille "Calendrier" avec la liste de validation en C63 :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, base As Range, i As Variant, coul&
Set c = [C63] 'à adapter
Set base = [E65:E68] 'à adapter
i = Application.Match(c, base, 0)
If IsError(i) Then coul = xlNone Else coul = base(i, 0).Interior.ColorIndex
c.Interior.ColorIndex = coul
Calculate 'recalcule les formules volatiles
End Sub

A+

 

[stef2872]

Bonjour Job75,

Merci pour ta contribution.
Effectivement, les cellules de calcul suivent les colonnes en fonction du choix du mois.

Je prends également !

Merci encore et bonne journée