[RÉSOLU] >> ASTUCE en VBA à rectifier >> [RÉSOLU]

DEMERS

XLDnaute Nouveau
BONJOUR à Toutes et à Tous

Je relance le sujet car j'ai un petit souci. Dans un tableau, j'ai effectué des mises en forme conditionnelles sur chaque colonne de façon à faire apparaître en rouge les jours fériés non payés, et en vert les jours fériés payés.

Dans des autres colonnes, je souhaite compter la combinaison de couleur qui se réunie sur une ligne du tableau conformément à l’une des formes données sur le fichier, le comptage se fait par 1 ou 2 ou 3:

À savoir que sur une même ligne, il ne peut se réunir qu’une seule et unique forme.
( 2 formes ensemble n’est pas possible)

Dans chaque cas, la fonction me retourne 0. Or si je change manuellement le contenu des cellules pour la mettre en conformité avec les formes tracées, j'obtiens bien le résultat attendu.
C'est normal, vu que la couleur en MEFC n'est pas considérée comme une couleur au sens d'Excel. Il me faut donc reprendre la condition de la MEFC et la traduire en VBA pour pouvoir appliquer une mise en forme par macro au lieu de MEFC, mais je ne sais pas comment la faire.

Par conséquent, je vous appelle de bien vouloir m’aider comment puis-je compter le nombre des cellules colorées selon les différentes formes à la suite de mes mises en forme conditionnelle, ou comment traduire les conditions de MEFC par une fonction VBA au lieu par des formules avec MEFC

- Fichier ci-joint.

Je vous remercie vivement, par avance.
 

Pièces jointes

  • TEST_1.xls
    62 KB · Affichages: 26
  • TEST_1.xls
    62 KB · Affichages: 24
  • TEST_1.xls
    62 KB · Affichages: 22
Dernière édition:

CISCO

XLDnaute Barbatruc
Re : BLOCAGE // ASTUCE en VBA à rectifier

Bonsoir

Comment est-ce que tu obtiens la couleur rouge dans ton fichier réel, manuellement, ou par l'intermédiaire d'une MFC ? Dans ce dernier cas, quelle est la condition à vérifier donnant cette couleur rouge ?

@ plus
 

DEMERS

XLDnaute Nouveau
Re : BLOCAGE // ASTUCE en VBA à rectifier

Bonsoir

Comment est-ce que tu obtiens la couleur rouge dans ton fichier réel, manuellement, ou par l'intermédiaire d'une MFC ? Dans ce dernier cas, quelle est la condition à vérifier donnant cette couleur rouge ?

@ plus

Bonsoir à VOUS, CISCO
le marquage en rouge se fait par bouton de commande, c-à-d, on sélectionne la case concerné et on clique sur le bouton libellé (ABSENT).
 

job75

XLDnaute Barbatruc
Re : BLOCAGE // ASTUCE en VBA à rectifier

Bonjour DEMERS, CISCO,

DEMERS votre fichier est bien trop compliqué avec les MFC et les couleurs appliquées aux motifs (pattern).

Je l'ai donc modifié, voyez le fichier joint :

- les couleurs sont maintenant partout des couleurs de fond (Interior)

- j'ai conservé les MFC uniquement pour les titres en D15:AH16

- sur D17:AH32 plus de MFC, les couleurs peuvent être appliquées par Copier-Collage spécial-Formats des "formes"

- les formules en AJ17:AJ32 utilisent cette fonction VBA :

Code:
Function SommeCouleur(P As Range, R As Range, V As Range)
Application.Volatile
Dim c As Range, i As Byte, suite$, s$
'---recherche couleur rouge dans P---
For Each c In P
 If c.Interior.ColorIndex = 3 Then Exit For
Next
If c Is Nothing Then Exit Function
'---suite des couleurs dans P---
i = 1
While c(, i).Interior.ColorIndex <> xlNone
  suite = suite & ";" & c(, i).Interior.ColorIndex
  i = i + 1
Wend
'---recherche dans R---
For Each c In R
  If c.Interior.ColorIndex = 3 Then
    i = 1: s = ""
    While c(, i).Interior.ColorIndex <> xlNone
      s = s & ";" & c(, i).Interior.ColorIndex
      i = i + 1
    Wend
    If s = suite Then
      SommeCouleur = Intersect(V, c.EntireRow)
      Exit Function
    End If
 End If
Next
End Function
A+
 

Pièces jointes

  • TEST(1).xls
    71.5 KB · Affichages: 26
  • TEST(1).xls
    71.5 KB · Affichages: 23
  • TEST(1).xls
    71.5 KB · Affichages: 27

DEMERS

XLDnaute Nouveau
Re : BLOCAGE // ASTUCE en VBA à rectifier

Re DEMERS,

Pourquoi à 10h09 avez-vous retiré votre fichier du post #1 :confused: Heureusement qu'il y a le mien :rolleyes:

A+

Bonjour JOB75;
Tout d'abord je tiens à vous remercier pour l’intérêt que vous avez porté à mon sujet.
d'autre part, je vous suis bien reconnaissant d'avoir pris le temps pour trouver et donner solution à ma petite application.

je l'ai retiré hier juste pour lui apporter une modification consistant en qlq modifications et ajout de boutons de commande, afin qu'elle soit bien claire et compréhensible.

La solution VBA que vous avez faite c'est pratique mais reste semi-automatique (si l'on peut dire) puisque il y a des actions à faire manuellement.
Je préfère (s'il est possible bien-sur) d'applique une MFC avec VBA afin que la coloration des colonnes soit des couleurs réelles au sens d'excel. ( de cette façon le problème serait bien résolu)
Amicalement
 

job75

XLDnaute Barbatruc
Re : BLOCAGE // ASTUCE en VBA à rectifier

Bonjour DEMERS,

Ces macros, lancées par 2 boutons, appliquent où effacent les couleurs qu'auraient mises les MFC :

Code:
Sub AppliquerCouleursMFC()
Dim r As Range, lig&, mfc1&, mfc2&, mfc3&, dat&, wd As Byte, a$, m As Range
Set r = [D17:AH32]
lig = 15 'ligne des dates
mfc1 = [K7].Interior.ColorIndex
mfc2 = [L7].Interior.ColorIndex
mfc3 = [S7].Interior.ColorIndex
Application.ScreenUpdating = False
If Not IsError([MFC]) Then [MFC].Interior.ColorIndex = xlNone 'RAZ
For Each r In r
  dat = r.Offset(lig - r.Row)
  wd = Weekday(dat)
  a = r.Offset(lig - r.Row).Address
  If wd = 1 Then _
    r.Interior.ColorIndex = mfc1: Set m = Union(r, IIf(m Is Nothing, r, m))
  If Evaluate("SUM((FERIES=" & a & ")*(CJF=""PY"")*(" & wd & "<>1))") Then _
    r.Interior.ColorIndex = mfc2: Set m = Union(r, IIf(m Is Nothing, r, m))
  If Evaluate("SUM((FERIES=" & a & ")*(CJF=""NP"")*(" & wd & "<>1))") Then _
    r.Interior.ColorIndex = mfc3: Set m = Union(r, IIf(m Is Nothing, r, m))
Next
ActiveSheet.Names.Add "MFC", m 'mémorisation par un nom défini dans la feuille
ActiveSheet.Calculate 'recalcul des fonctions SommeCouleur
End Sub

Sub EffacerCouleursMFC()
If Not IsError([MFC]) Then [MFC].Interior.ColorIndex = xlNone 'RAZ
ActiveSheet.Calculate 'recalcul des fonctions SommeCouleur
End Sub
Les zones ainsi créées sont mémorisées par le nom MFC défini dans la feuille.

Ces macros peuvent donc fonctionner sur plusieurs feuilles (mois).

Fichier (2).

A+
 

Pièces jointes

  • TEST(2).xls
    102 KB · Affichages: 15
  • TEST(2).xls
    102 KB · Affichages: 16
  • TEST(2).xls
    102 KB · Affichages: 17
Dernière édition:

job75

XLDnaute Barbatruc
Re : BLOCAGE // ASTUCE en VBA à rectifier

Re,

Pour finir, on peut automatiser le "copier-coller" des "Formes" avec cette macro dans ThisWorkbook :

Code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim r As Range, i As Byte
Static mem As Range 'mémorise
If IsDate("1/" & Sh.Name) Then 'feuilles des mois
  Set r = Intersect(Target, Sh.[D7:AF11])
  If Not r Is Nothing Then Set mem = r.Areas(1).Rows(1).Cells: Exit Sub
  Set r = Intersect(Target, Sh.[D17:AH32])
  If r Is Nothing Then
    Set mem = Nothing 'RAZ
  ElseIf Not mem Is Nothing Then
    For i = 1 To mem.Count
      If Not Intersect(r(1, i), Sh.[D17:AH32]) Is Nothing Then _
        r(, i).Interior.ColorIndex = mem(, i).Interior.ColorIndex
    Next
    'Set mem = Nothing 'facultatif, si l'on ne veut pas faire plusieurs "coller"
    Sh.Calculate 'recalcul des fonctions SommeCouleur
  End If
End If
End Sub
Sélectionner une forme dans D7:AF11 puis cliquer dans D17:AH32.

Fichier (3).

Nota : en feuille "Février" la plage U22:X22 n'est pas prise en compte par la fonction SommeCouleur.

C'est normal vu son mode de calcul, on peut y remédier en effaçant la couleur de Y22...

A+
 

Pièces jointes

  • TEST(3).xls
    108.5 KB · Affichages: 28
  • TEST(3).xls
    108.5 KB · Affichages: 27
  • TEST(3).xls
    108.5 KB · Affichages: 29

DEMERS

XLDnaute Nouveau
Re : BLOCAGE // ASTUCE en VBA à rectifier

Re-Bonsoir Job75
Cette fois-ci, c'est impeccable. le problème est radicalement résolu.
je essayé le fichier avec tous les mois de l'année, et il fonctionne parfaitement sans le moindre problème.

Un grand merci, vs êtes génie en la matière et je vous suis bien reconnaissant.
Mes vives remerciements.

- Amicalement.
 
Haut Bas