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 2e 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+