VBA中如何同时选中多个同属性Shape并批量设置属性？

嘿，作为VBA新手遇到这种重复代码的问题太正常啦！你现在的困扰是每次都要单独选择两个形状、重复设置相同属性，而且Worksheet.SelectAll根本不是用来选中特定两个形状的（它会选中工作表所有对象，这肯定不是你要的效果）。下面给你两种简单可行的解决方法，帮你摆脱重复操作的麻烦：

方法1：把属性封装成子过程，直接操作Shape对象（推荐） #

最靠谱的方式是完全抛弃Selection，直接对创建好的Shape变量进行操作。我们可以把重复的属性设置代码抽成一个独立的子过程，然后分别传给两个形状，这样代码更简洁，还不容易出错。

首先添加这个子过程：

Private Sub FormatShape(targetShp As Shape, textValue As Long)
    With targetShp
        ' 设置填充为透明
        .Fill.Visible = msoFalse
        ' 设置文本内容和格式
        With .TextFrame
            .Characters.Text = textValue
            .Characters.Font.ColorIndex = 3
            .HorizontalAlignment = xlHAlignCenter
            .VerticalAlignment = xlVAlignCenter
        End With
        ' 设置边框样式
        With .Line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
End Sub

然后修改你的主过程，直接调用这个子过程：

Private Sub RUN()
    Dim x As Long, cel As Range, ws As Worksheet, shp As Shape
    Dim y As Long, z As Long, orow As Long, ocol As Long, cel0 As Range, shp1 As Shape
    
    Set ws = ActiveSheet
    orow = 3
    ocol = 3
    y = ws.Range("A4").Value
    z = ws.Range("A5").Value 'number shapes
    Set cel = Range("E6")
    Set cel0 = cel.Offset(orow * (z - 1) + 4, 0)
    
    For x = 1 To y
        ' 创建两个椭圆形状
        Set shp = ws.Shapes.AddShape(msoShapeOval, cel.Left, cel.Top, cel.Width, cel.Width)
        Set shp1 = ws.Shapes.AddShape(msoShapeOval, cel0.Left, cel0.Top, cel0.Width, cel0.Width)
        
        ' 直接调用子过程设置属性，不用选中任何对象！
        FormatShape shp, x
        FormatShape shp1, x
        
        ' 移动到下一列
        Set cel = cel.Offset(0, ocol)
        Set cel0 = cel0.Offset(0, ocol)
    Next x
End Sub

这种方法的好处是：代码复用性高，以后要修改形状样式，只需要改FormatShape子过程就行；而且完全不依赖选中状态，避免了切换工作表时Selection失效的问题。

方法2：创建ShapeRange批量设置（适合需要选中多个形状的场景） #

如果你确实需要同时选中这两个形状（比如后续要对它们做统一移动、缩放等操作），可以创建一个包含这两个形状的ShapeRange，然后批量设置属性，还能直接选中这个范围。

修改后的主过程代码：

Private Sub RUN()
    Dim x As Long, cel As Range, ws As Worksheet, shp As Shape
    Dim y As Long, z As Long, orow As Long, ocol As Long, cel0 As Range, shp1 As Shape
    Dim shapeRange As ShapeRange ' 新增ShapeRange变量
    
    Set ws = ActiveSheet
    orow = 3
    ocol = 3
    y = ws.Range("A4").Value
    z = ws.Range("A5").Value 'number shapes
    Set cel = Range("E6")
    Set cel0 = cel.Offset(orow * (z - 1) + 4, 0)
    
    For x = 1 To y
        ' 创建两个椭圆形状
        Set shp = ws.Shapes.AddShape(msoShapeOval, cel.Left, cel.Top, cel.Width, cel.Width)
        Set shp1 = ws.Shapes.AddShape(msoShapeOval, cel0.Left, cel0.Top, cel0.Width, cel0.Width)
        
        ' 通过形状名称创建包含两个形状的ShapeRange
        Set shapeRange = ws.Shapes.Range(Array(shp.Name, shp1.Name))
        
        ' 批量设置所有属性
        With shapeRange
            .Fill.Visible = msoFalse
            With .TextFrame
                .Characters.Text = x
                .Characters.Font.ColorIndex = 3
                .HorizontalAlignment = xlHAlignCenter
                .VerticalAlignment = xlVAlignCenter
            End With
            With .Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 0, 0)
                .Transparency = 0
            End With
        End With
        
        ' 如果需要选中这两个形状，执行下面这行
        shapeRange.Select
        
        ' 移动到下一列
        Set cel = cel.Offset(0, ocol)
        Set cel0 = cel0.Offset(0, ocol)
    Next x
End Sub

这里要注意：Shapes.Range()需要传入形状的名称数组或者索引数组，所以我们用Array(shp.Name, shp1.Name)来指定要包含的两个形状。

小提示 #

在VBA开发里，尽量避免使用Selection和Activate这类依赖当前状态的操作，直接操作对象变量（比如这里的shp、shp1、shapeRange）是更稳定、高效的写法哦！

内容的提问来源于stack exchange，提问作者Pramod Pandit