Problème avec les mise en forme et macro de recherche

[jtitin]

Bonjour à tous
j'ai un problème avec les mise en forme
je met des cellules en couleur, en fonction du contenu ,sur différentes colonnes d'une base de données avec la mise en forme suivante:
=SI(O1="";"";AUJOURDHUI()>=DATE(ANNEE(O1)+2;MOIS(O1);JOUR(O1))) ---> pour du ROUGE
=SI(O1="";"";AUJOURDHUI()>=DATE(ANNEE(O1)+2;MOIS(O1)-2;JOUR(O1))) ---> pour du JAUNE

mais le problèmes est que lorsque je recherche ces cellules de couleur rouge ou jaune dans la colonne défini le résultat est nul. ne retrouve aucune cellule colorées. le code de recherche est le suivant code de Berere que je remerci)

With Worksheets("Feuil1")
Set c = .Range("F5:F" & .Range("F65536").End(xlUp).Row).Find(ListBox1, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If c.Offset(, 9).Interior.ColorIndex = 3 Or c.Offset(, 9).Interior.ColorIndex = 6 Then
ReDim Preserve tbl(0 To 11, 0 To i)
tbl(0, i) = c.Offset(, -5)
tbl(1, i) = c.Offset(, -4)
tbl(2, i) = c.Offset(, 9)
tbl(3, i) = c.Offset(, 10)
tbl(4, i) = c.Offset(, 42)
tbl(5, i) = c.Offset(, 43)
tbl(6, i) = c.Offset(, 44)
tbl(7, i) = c.Offset(, 45)
tbl(8, i) = c.Offset(, 46)
tbl(9, i) = c.Offset(, 47)
tbl(10, i) = c.Offset(, 48)
i = i + 1
End If
Set c = .Range("F5:F" & .Range("F65536").End(xlUp).Row).FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If

Comment peut on remplacé les mise en forme sur la feuille en fonction de la valeur des cellules en VBA pour contrer, je pense ce problème
Si la couleur est mise manuellement les cellules rouge ou jaune sont trouvées par la macro

merci pour vos conseils

 

[Compte Supprimé 979]

Re : Problème avec les mise en forme et macro de recherche

Salut Jtitin

Dans une MFC la couleur de la cellule n'est pas donnée par .Interior.ColorIndex
Donc ton résultat sera toujours égal à Null

En faisant un minimum de recherche tu aurais pu trouver
cette fonction qui retourne la couleur de la MFC d'une cellule

' Fonctionne avec Excel 2003 mais pas avec version supérieure
Public Function CouleurMFC(RG As Range, Optional Mode As Byte = 0) As Variant
Dim e As Long, i As Byte, LoTest As Boolean
Dim LoMFC As FormatCondition
    Application.Volatile
    'boucle sur le nombre de condition(s)
    'Si pas de MFC .FormatConditions.Count renvoi 0
    For i = 1 To RG.FormatConditions.Count
        Set LoMFC = RG.FormatConditions(i)
        If LoMFC.Type = xlCellValue Then
        'tester le type de la formule entrée
            Select Case LoMFC.Operator
            Case xlEqual
                LoTest = RG = Evaluate(LoMFC.Formula1)
            Case xlNotEqual
                LoTest = RG <> Evaluate(LoMFC.Formula1)
            Case xlGreater
                LoTest = RG > Evaluate(LoMFC.Formula1)
            Case xlGreaterEqual
                LoTest = RG >= Evaluate(LoMFC.Formula1)
            Case xlLess
                LoTest = RG < Evaluate(LoMFC.Formula1)
            Case xlLessEqual
                LoTest = RG <= Evaluate(LoMFC.Formula1)
            Case xlNotBetween
                LoTest = (RG < Evaluate(LoMFC.Formula1) Or RG > Evaluate(LoMFC.Formula2))
            Case xlBetween
                LoTest = (RG >= Evaluate(LoMFC.Formula1)) And (RG <= Evaluate(LoMFC.Formula2))
            End Select
            If LoTest Then
                'Peu ajouter d'autre format si nécessaire,
                'comme la bordure, la police etc..
                Select Case Mode
                Case 0
                    CouleurMFC = LoMFC.Interior.ColorIndex
                Case 1
                    CouleurMFC = LoMFC.Interior.Color
                End Select
                Exit Function
            End If
        End If
    Next i
    CouleurMFC = 0
End Function

Pour l'appeler il suffit de faire le test

If CouleurMFC(c.Offset(, 9)) = 3 Or CouleurMFC(c.Offset(, 9)) = 6 Then

A+

 

[nyko283]

Re : Problème avec les mise en forme et macro de recherche

Bonjour Jtitin, le forum,

N'ayant qu'excel 2003, mais je ne pense pas que le principe ait changer depuis, lors de la modification de la couleur de fond d'une cellule par une mise en forme, la proprièté interior.color ne change pas, donc tu ne peut la récuperer par le code.

une solution que j'avai deja utilisé, consistait a coder ta MFC et de l'inclure dans l'évènement calculate de ta feuille par exemple ou de créer un bouton d'appel
exemple de code:

Dim mycell As Range
For Each mycell In Range("A1:A10")
    If Range("O1") <> "" Then
        If Date >= DateSerial(Year(Range("O1")) + 2, Month(Range("O1")), Day(Range("O1"))) Then
            mycell.Interior.ColorIndex = 3
        ElseIf Date >= DateSerial(Year(Range("O1")) + 2, Month(Range("O1")) - 2, Day(Range("O1"))) Then
            mycell.Interior.ColorIndex = 6
        Else
            mycell.Interior.ColorIndex = xlNone
        End If
    Else
        mycell.Interior.ColorIndex = xlNone
    End If
Next mycell

Edit : Bonjour Bruno

 

[Gurgeh]

Re : Problème avec les mise en forme et macro de recherche

Salut nyko283

Il me semble que le post suivant apporte une réponse à ton problème : https://www.excel-downloads.com/threads/vba-et-mise-en-forme-conditionnelle.32504/

Gurgeh

 

[jtitin]

Re : Problème avec les mise en forme et macro de recherche

merci pour vos réponses.
mais je ne parvient pas à faire fonctionner.
BrunoM45, la fonction doit elle être dans un module ou dans l'userform
je ne comprend pas les RG.FormatConditions, je ne sais pas si la mise en forme que j'applique est pris en compte dans ces format

merci encore

 

[Compte Supprimé 979]

Re : Problème avec les mise en forme et macro de recherche

Salut Jtitin,

Ou se trouve ton code que tu nous as donné dans ton 1er post !?
La fonction peut se trouver dans n'importe quel module puisqu'elle est "Public"

A+

 

[jtitin]

Re : Problème avec les mise en forme et macro de recherche

Re bonjour BrunoM45
mon code ce trouve dans un userform voir ci dessous
et je place la fonction CouleurMFC dans un module

Private Sub UserForm_Initialize()
Dim dl As Integer
Dim col As New Collection 'déclare la variable col (COLlection)
OptionButton1.Value = True
Me.ListBox1.MultiSelect = fmMultiSelectSingle
dl = Sheets("Feuil1").Range("F65536").End(xlUp).Row
Set pl = Sheets("Feuil1").Range("F5:F" & dl)

For Each cel In pl
On Error Resume Next
col.Add cel.Value, CStr(cel.Value)
Next cel
On Error GoTo 0
For X = 1 To col.Count
ListBox1.AddItem col(X)
Next X

ListBox1.ColumnCount = 1
ListBox1.ColumnWidths = "40"

With ListBox2

.ColumnCount = 20
.ColumnWidths = "90;80;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60"
End With


End Sub

Private Sub ListBox1_Click() 'bebere
Dim tbl() As String

'ReDim tbl(0 To 7, 0 To i)

If Me.ListBox1 <> "" Then
Me.ListBox2.Clear
i = 0

With Worksheets("Feuil1")
Set c = .Range("F5:F" & .Range("F65536").End(xlUp).Row).Find(ListBox1, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If c.Offset(, 9).Interior.ColorIndex = 3 Or c.Offset(, 9).Interior.ColorIndex = 6 Then 'date1
''''''If CouleurMFC(c.Offset(, 9)) = 3 Or CouleurMFC(c.Offset(, 9)) = 6 Then
ReDim Preserve tbl(0 To 11, 0 To i)
tbl(0, i) = c.Offset(, -5)
tbl(1, i) = c.Offset(, -4)
tbl(2, i) = c.Offset(, 9)
tbl(3, i) = c.Offset(, 10)
tbl(4, i) = c.Offset(, 42)
tbl(5, i) = c.Offset(, 43)
tbl(6, i) = c.Offset(, 44)
tbl(7, i) = c.Offset(, 45)
tbl(8, i) = c.Offset(, 46)
tbl(9, i) = c.Offset(, 47)
tbl(10, i) = c.Offset(, 48)
i = i + 1
End If
Set c = .Range("F5:F" & .Range("F65536").End(xlUp).Row).FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If

End With
On Error Resume Next
If UBound(tbl, 2) <> 0 Then
Me.ListBox2.List = Application.Transpose(tbl)
Else
Me.ListBox2.AddItem
Me.ListBox2.Column() = tbl
End If
End If

End Sub

 

[jtitin]

Re : Problème avec les mise en forme et macro de recherche

je precise que si les cellules non pas la mise en forme conditionnelle mais une couleur appliquée
la macro fonctionne avec
If c.Offset(, 9).Interior.ColorIndex = 3 Or c.Offset(, 9).Interior.ColorIndex = 6 Then

esque la mise en forme conditionnelle que j'applique est prise en compte par la fonction "CouleurMFC " ??????

=SI(O1="";"";AUJOURDHUI()>=DATE(ANNEE(O1)+2;MOIS(O 1);JOUR(O1))) ---> pour couleur ROUGE
=SI(O1="";"";AUJOURDHUI()>=DATE(ANNEE(O1)+2;MOIS(O 1)-2;JOUR(O1))) ---> pour couleur JAUNE

 

[Compte Supprimé 979]

Re : Problème avec les mise en forme et macro de recherche

Re,

Le problème de ma fonction, c'est qu'elle ne fonctionne qu'avec Excel 2003 et antérieur
mais pas sur les nouvelles versions (je n'avais pas fait attention)

Peux-tu nous joindre un extrait de ton fichier !?

A+

 

[jtitin]

Re : Problème avec les mise en forme et macro de recherche

alors voilà un bout de code
avec la mise en forme conditionnelle et recherche dans listbox
merci pour votre aide