CODEWITHSUNDEEP
vbaexcel
Mikelowski
Mikelowski

Reputation: 195

Color shape according to its text

I have a sheet with several shapes which have text strings, I'd like to color those shapes based on its text. Here is the code I have that for now it doesn't work as expected.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim shp As Shape, r As Long, g As Long, b As Long, NormScale As String

With ActiveSheet
    For Each shp In .Shapes
        With shp.TextFrame
            Select Case NormScale
            Case "N"
                r = 255
                g = 0
                b = 0
            Case "P"
                r = 128
                g = 128
                b = 128
            End Select
        End With
        shp.Fill.ForeColor.RGB = RGB(r, g, b)
    Next shp
End With

End Sub

Upvotes: 3

Views: 163

Answers (1)

Gary's Student
Gary's Student

Reputation: 96781

You just forgot to read the text:

Sub Mike()

Dim shp As Shape, r As Long, g As Long, b As Long, NormScale As String

With ActiveSheet
    For Each shp In .Shapes
        With shp.TextFrame
            NormScale = .Characters.Text
            Select Case NormScale
            Case "N"
                r = 255
                g = 0
                b = 0
            Case "P"
                r = 128
                g = 128
                b = 128
            End Select
        End With
        shp.Fill.ForeColor.RGB = RGB(r, g, b)
    Next shp
End With

End Sub

EDIT#1:

To exclude specific Shapes from the process, we must first identify then:

Sub WhatDoWeHave()
Dim shp As Shape
With ActiveSheet
    For Each shp In .Shapes
        MsgBox shp.Type & vbCrLf & shp.Name
    Next shp
End With
End Sub

EDIT#2:

This version will exclude Shapes whose Name begins with "Picture"

Sub Mike()

Dim shp As Shape, r As Long, g As Long, b As Long, NormScale As String

With ActiveSheet
    For Each shp In .Shapes
        If InStr(shp.Name, "Picture") = 0 Then
            With shp.TextFrame
                NormScale = .Characters.Text
                Select Case NormScale
                Case "N"
                    r = 255
                    g = 0
                    b = 0
                Case "P"
                    r = 128
                    g = 128
                    b = 128
                End Select
            End With
            shp.Fill.ForeColor.RGB = RGB(r, g, b)
        End If
    Next shp
End With

End Sub

Upvotes: 4

Related Questions