Colored form according to its text
I have a sheet with several shapes that have text lines, I would like to color these shapes based on its text. Here is the code I have while 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
+3
source to share
1 answer
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 certain forms 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 forms whose name begins with "Image"
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
+4
source to share