根据文字的颜色形状

时间:2014-12-01 11:25:54

标签: vba excel-vba excel

我有一张包含多个文字字符串形状的表格,我想根据文字对这些形状进行着色。这是我现在的代码,它现在没有按预期工作。

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

1 个答案:

答案 0 :(得分:4)

你忘了阅读文字:

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:

此版本将排除其名称以“图片”开头的形状

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