Mise en forme conditionnelle via scrollbar

Bonjour à tous !

Sur ma feuil3 TODO

j'utilise un scrollbar pour faire défiler la date ; les lignes qui contiennent dans une de leurs cellules la date choisi par la scrollbar apparaissent.

Je voudrais que la cellule concerné (ou la date se trouve) se mette en forme et j'utilise ce code qui ne fonctione manifestement pas...

Sub MFC()
    On Error Resume Next

    '*************************************************************************************
    Dim Plage_MFC As Excel.Range, FC1 As Excel.FormatCondition

    f2.Range("I2").Select
    Set Plage_MFC = f2.Range("I2:O" & Lig_Dest)
    Plage_MFC.FormatConditions.Delete

    Set FC1 = Plage_MFC.FormatConditions.Add(Type:=xlExpression, Formula1:="=ET(I2<>"";I2=$Q$1)")
    FC1.Interior.Color = RGB(192, 0, 0)
    FC1.Font.Color = RGB(255, 255, 255)

    Set FC1 = Nothing
    Set Plage_MFC = Nothing
End Sub

En pj le tableau vidé avec juste des données neutres.

Merci pour vos retours !

Bonjour,

A quoi correspond la variable f2?

Elle correspond à ma feuil TODO "edit il s'agit bien de la feuil2 et non de la feuil3"

Bonjour,

2 problèmes:

-Dans la macro "Importer_ligne", il manque l'appel à la macro MFC, à ajouter en dernière ligne.

-Dans l'écriture de la formule de la MFC, il faut doubler les doubles-cotes lorsqu'on veut dire ="", la formule doit s'écrire ainsi:

"=ET(I2<>"""";I2=$Q$1)")

les macros "Importer_Ligne et "MFC" après correction.

Sub Importer_Ligne()
    Dim Date_Select As Date
    Application.ScreenUpdating = False
    Set f1 = Sheets("En contact")
    Set f2 = Sheets("TODO")
    f2.Range("A2:O1000").ClearContents 'effacement résultats précédents
    f2.ListObjects("Tableau3").Resize Range("$A$1:$O$2") 'Reduction du tableau

    Date_Select = f2.Range("Q1").Value
    Lig_Dest = 2

    With f1.ListObjects("Tableau2").Range
        On Error Resume Next
        Set d = .Find(Date_Select)
        If Err.Number = 0 Then
            Deb = d.Row
            If Not d Is Nothing Then
                Do
                    Range(f1.Cells(d.Row, "A"), f1.Cells(d.Row, "O")).Copy f2.Cells(Lig_Dest, "A")
                    Lig_Dest = Lig_Dest + 1
                    Set d = .FindNext(d)
                Loop While Not d Is Nothing And d.Row <> Deb
            End If
        End If
        On Error GoTo 0
    End With
    MFC 'appel de la macro MFC
End Sub

Sub MFC()
    On Error Resume Next

    '*************************************************************************************
    Dim Plage_MFC As Excel.Range, FC1 As Excel.FormatCondition
    f2.Range("I2").Select
    Set Plage_MFC = f2.Range("I2:O" & Lig_Dest)
    Plage_MFC.FormatConditions.Delete

    Set FC1 = Plage_MFC.FormatConditions.Add(Type:=xlExpression, Formula1:="=ET(I2<>"""";I2=$Q$1)")
    FC1.Interior.Color = RGB(192, 0, 0)
    FC1.Font.Color = RGB(255, 255, 255)

    Set FC1 = Nothing
    Set Plage_MFC = Nothing
End Sub

Cdlt

[s=co-548dd4][/s]

Super merci Arturo pour ces précisions ! Je valide le post !