更改形状颜色和 3D 格式

Question

我想要不同的颜色格式，使用

msoShapeStylePreset

使用 RGB 应用颜色。

当我尝试使用 RGB 应用颜色时，它用两种颜色填充形状，这不是我想要的。

目标是当选择任何形状时，其颜色应该改变，而其余形状保持不变。
我还想要选择两者的颜色组合的选项。

Sub Select1()
    Sheet1.Shapes("Group 1").ShapeStyle = msoShapeStylePreset41
    Sheet1.Shapes("Shape1").ShapeStyle = msoShapeStylePreset27
    With Sheet1.Shapes("Shape1").ThreeD
        .BevelTopType = msoBevelCircle
        .BevelTopInset = 6
        .BevelTopDepth = 6
    End With
End Sub

Sub Select2()
    Sheet1.Shapes("Group 1").ShapeStyle = msoShapeStylePreset41
    Sheet1.Shapes("Shape2").ShapeStyle = msoShapeStylePreset27
    With Sheet1.Shapes("Shape2").ThreeD
        .BevelTopType = msoBevelCircle
        .BevelTopInset = 6
        .BevelTopDepth = 6
    End With
End Sub

我想像这样改变颜色：

Answer 1

为每个形状分配宏

• 右键单击形状 >

  Assign Macro

  ，选择

  ShpClick

  ，单击 确定

Sub ShpClick()
    Dim HLColor As Long
    Dim sCaller As String
    HLColor = RGB(0, 255, 0) ' modify as needed
    sCaller = Application.Caller
    Sheet1.Shapes("Group 1").ShapeStyle = msoShapeStylePreset9
    With Sheet1.Shapes(sCaller).Fill
        .Visible = msoTrue
        .ForeColor.RGB = HLColor
        .Transparency = 0
        .Solid
    End With
    With Sheet1.Shapes(sCaller).ThreeD
        .BevelTopType = msoBevelCircle
        .BevelTopInset = 6
        .BevelTopDepth = 6
    End With
End Sub