Excel VBA中的多个选择（形状），需要提示

我有两个具有相同属性的形状（shp和shp1）。我只是想知道是否有办法同时选择两个形状（shp.select和shp1.select），这样我就不必选择两次并分配两次属性。我尝试了WORKEM.selectall，但结果是错误的。我只是这方面的新手，所以我想找到一种方法

Private Sub RUN()
    Dim x As Long, cel As Range, ws As Worksheet, shp As Shape, 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)
        shp.Select
         With Selection.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
        shp1.Select
        With Selection.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
        Set cel = cel.Offset(0, ocol)
        Set cel0 = cel0.Offset(0, ocol)
        Next

---

尝试

ws.Shapes。选择all

以选择工作表上的所有形状

要选择两个特定形状，可以使用下一种方法：

 Dim sel As ShapeRange
  Set sel = ws.Shapes.Range(Array(ws.Shapes(1).Name, ws.Shapes(2).Name))
  sel.Select

 Dim sel As ShapeRange
  Set sel = ws.Shapes.Range(Array("xx", "yy"))
   'or
  Set sel = ws.Shapes.Range(Array(shp.Name, shp1.Name))
   sel.Select
   'but they must have different names, in order to be individually identified!

为了使用特定的方式（shp和shp1），必须在创建后命名它们

shp.Name=“xx”

和

shp1.Name=“yy”

然后按以下方式使用：

 Dim sel As ShapeRange
  Set sel = ws.Shapes.Range(Array(ws.Shapes(1).Name, ws.Shapes(2).Name))
  sel.Select

 Dim sel As ShapeRange
  Set sel = ws.Shapes.Range(Array("xx", "yy"))
   'or
  Set sel = ws.Shapes.Range(Array(shp.Name, shp1.Name))
   sel.Select
   'but they must have different names, in order to be individually identified!

现在，请使用下一个（你的）改编代码来做（我理解）你需要的事情。它在相关领域有评论，我认为它很容易被理解。不要忘记在单元格“A4”中有一个值。。。代码首先删除现有形状（如果有）。如果不需要，可以对这些行进行注释：

Private Sub RUN()
    Dim x As Long, cel As Range, ws As Worksheet, shp As Shape, y As Long, z As Long
    Dim orow As Long, ocol As Long, cel0 As Range, shp1 As Shape
    Dim sel As ShapeRange, sh As Shape 'new declarations

    Set ws = ActiveSheet
    orow = 3: ocol = 3

    y = ws.Range("A4").value
    z = ws.Range("A5").value

    Set cel = Range("E6")
    Set cel0 = cel.Offset(orow * (z - 1) + 4, 0)

    'New: delete all existingn shapes, if any_______________
      ws.Shapes.SelectAll: Selection.Delete
    '_______________________________________________________

    'firstly create all shapes and write their TextFrame text:
    For x = 1 To y
        Set shp = ws.Shapes.AddShape(msoShapeOval, cel.left, cel.top, cel.width, cel.width)
          shp.TextFrame.Characters.text = x
        Set shp1 = ws.Shapes.AddShape(msoShapeOval, cel0.left, cel0.top, cel0.width, cel0.width)
          shp1.TextFrame.Characters.text = x

        Set cel = cel.Offset(0, ocol)
        Set cel0 = cel0.Offset(0, ocol)
    Next x
     'create the shaperange of all existing shapes___
     ws.Shapes.SelectAll
     Set sel = Selection.ShapeRange
     '_______________________________________________
    'Changge what can be done at once (except TextFrame properties)
    With sel
        .Fill.Visible = msoFalse
        With .Line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    '____________________________________________________________

    'Change TextFrame properties (individually for each shape):
    For Each sh In sel
        With sh.TextFrame
            .Characters.Font.ColorIndex = 3
            .HorizontalAlignment = xlHAlignCenter
            .VerticalAlignment = xlVAlignCenter
        End With
    Next
    '__________________________________________________________
End Sub

在“形状”集合中循环 应用于您的代码

Sub ForEach()

    Dim vntSh As Variant
    Dim vnt As Variant
    vntSh = Array(shp, shp1)

    For Each vnt In vntSh
        With vnt
            .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
    Next vnt

End Sub

' or:

Sub ForNext()

    Dim vntSh As Variant
    Dim i As Long
    vntSh = Array(shp, shp1)

    For i = 0 To UBound(vntSh)
        With vntSh(i)
            .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
    Next i

End Sub

---

它显示：“应用程序定义或对象定义错误”您在

ws

工作表上有任何形状吗？是否有方法选择like-shp&shp1。选择是，但不是以这种方式。我会用你们需要的方式编辑我的答案…纸上没有形状。