vba - 根据文字颜色形状

Question

我有一张包含多个带有文本字符串的形状的工作表，我想根据其文本为这些形状着色。这是我的代码，目前它无法按预期工作。

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

Answer 1

您只是忘记阅读文字:

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

编辑#1:

要从流程中排除特定的形状，我们必须首先识别，然后:

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

编辑#2:

此版本将排除名称以“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