Conditionnement de la couleur d'une forme

Bonjour,

J'aimerai pour un nombre de forme donné, vérifier si le nom qui a été donné à la forme est présent dans une colonne d'un tableau (qui est dans une autre feuille), si le nom n'y figure pas ne rien faire, si le nom y figure changer la couleur de la forme en question en une couleur définie.

Ce qui donnerai un truc comme ça:

->Pour chaque forme de la feuille active

->Si le nom est présent dans la colonne du tableau de la deuxième feuille

->Remplir la forme en rouge

J'appliquerai ensuite la méthode à un plus grand nombre de forme et à différents tableaux mais je préfère essayer de comprendre comment faire et le faire par moi-même si j'y arrive ^^

Je vous met un exemple tout con en feuille excel

Merci d'avance !

Bonjour,

Attention aux noms saisis dans la liste de votre fichier, dans la liste des objets, supprimez l'espace à la fin du mot "Rectangle".

le code

Option Explicit

Sub Coloriage()
    Dim Tabl As ListObject
    Dim f1 As Worksheet, f2 As Worksheet
    Dim i As Long, N As Long
    Dim Trouve As String, Forme As String, Liste As String

    Application.ScreenUpdating = False
    Set f1 = Sheets("Formes")
    Set f2 = Sheets("Tableau")
    Set Tabl = f2.ListObjects("Tableau1")
    Liste = Tabl.Range.Address
    'Récupération des objets dessinés
    N = ActiveSheet.Shapes.Count
    For i = 1 To N
        On Error Resume Next 'si une erreur est détectée on passe à la ligne suivante
        Forme = f1.Shapes(i).Name 'on récupère le nom de la forme dessinée
        Trouve = Application.Match(Forme, f2.Range(Liste), 0) 'on recherche son nom dans la liste
        If Err.Number = 0 Then f1.Shapes(Forme).Fill.ForeColor.RGB = RGB(255, 0, 0) 'si pas d'erreur, on applique la couleur rouge
        On Error GoTo 0 'dans tous les cas, on réinitialise la gestion d'erreur
    Next i
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Cdlt

Salut Romain,
Salut Arturo,

un double-clic sur la feuille 'Formes' démarre la macro

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim sSH$
'
Cancel = True
On Error Resume Next
Application.ScreenUpdating = False
'
With ActiveSheet
    For x = 1 To [Tableau1].Rows.Count
        sSH = [Tableau1].Item(x, 1)
        If Not .Shapes(sSH) Is Nothing Then .Shapes(sSH).Fill.ForeColor.RGB = RGB(255, 0, 0)
    Next
End With
Application.ScreenUpdating = True
On Error GoTo 0
'
End Sub

A+

Merci d'avoir proposé vos programmes, petites questions sur le programme de curulis:

-Comment faire en sort que le programme s’exécute avec un bouton plutôt qu'avec un double click (permettra "d'actualiser" en fonction du remplissement du tableau)

-Juste pour ma compréhension quel est la partie du programme qui "récupère" les données du tableau étant donné que le with est seulement sur l'ActiveSheet, je ne comprends pas comment le programme reconnait Tableau1 et le localise

Bonjour…

autre exemple mais avec un bouton bascule nommé Bt pour assurer un va et vient sur les formes citées en Tableau TS

Private Sub Bt_Click()
 Dim n As Byte, C As Range
    n = IIf(Bt, 255, 200)                                  ‘grise/vide
    Bt.Caption = IIf(Bt, "grise", "vide")
    For Each C In [TS]: Me.Shapes(C.Text).Fill.ForeColor.RGB = RGB(n, n, n):  Next
End Sub   

Salut Romain,
Salut l'équipe,

nouvelle version avec un bouton, une cellule [O4] dédiée au rouge et une autre en [O2] qui, via un double-clic, passe du gris au rouge d'une fois à l'autre.
Varions les plaisirs...

Public Sub Coloriage(ByVal iIdx%)
'
Dim sSH$
'
On Error Resume Next
Application.ScreenUpdating = False
'
For x = 1 To [Tableau1].Rows.Count
    sSH = [Tableau1].Item(x, 1)
    If Not Me.Shapes(sSH) Is Nothing Then _
        Me.Shapes(sSH).Fill.ForeColor.RGB = _
            IIf(iIdx = 0, RGB(255, 0, 0), _
            IIf(Range("O2").Interior.Color = RGB(255, 0, 0), RGB(255, 0, 0), RGB(230, 230, 230)))
Next
If iIdx = 2 Then Range("O2").Interior.Color = IIf(Range("O2").Interior.Color = RGB(255, 0, 0), RGB(230, 230, 230), RGB(255, 0, 0))
'
Application.ScreenUpdating = True
On Error GoTo 0
'
End Sub

Pour répondre à ta 2^e question, un des très nombreux avantages des tableaux structurés, comme celui utilisé dans la feuille 'Tableau' est justement d'être localisé automatiquement par Excel grâce à son nom unique.

A+