电源点VBA宏:运行时错误9

Question

我面临的运行时错误9:下标超出了以下代码的范围，但它一开始工作良好。但是后来当我协作所有模块来创建外接程序时，它的显示错误。

Sub SelectSimilarshapes()

  Dim sh As Shape
  Dim shapeCollection() As String
  Set sh = ActiveWindow.Selection.ShapeRange(1)
  ReDim Preserve shapeCollection(0)
  shapeCollection(0) = sh.Name
  Dim otherShape As Shape
  Dim iShape As Integer
  iShape = 1
  For Each otherShape In ActiveWindow.View.Slide.Shapes
    If otherShape.Type = sh.Type _
    And otherShape.AutoShapeType = sh.AutoShapeType _
    And otherShape.Type <> msoPlaceholder Then
    If (otherShape.Name <> sh.Name) Then
      ReDim Preserve shapeCollection(1 + iShape)
      shapeCollection(iShape) = otherShape.Name
      iShape = iShape + 1
    End If
    End If

  Next otherShape
  ActiveWindow.View.Slide.Shapes.Range(shapeCollection).Select


  Select Case iShape
    Case 1
      MsgBox "Sorry, no shapes matching your search criteria were found"

    Case Else
      MsgBox "Shapes matching your search criteria were found and are selected"
  End Select
NormalExit:
Exit Sub

err1:
     MsgBox "You haven't selected any object"
     Resume NormalExit:
End Sub

Answer 1

在声明数组或调整数组大小时，应该为该数组指定较低的和较高的索引，例如

ReDim Preserve shapeCollection(0 To 0)

而不是

ReDim Preserve shapeCollection(0)

在其他语言中，数组通常是从0索引的，也没有例外。

在VBA中，数组可以从任何值中索引，即

Dim array(5 To 10) As String

如果跳过较低的索引，它将具有默认值。内置默认值为0，但可以使用以下语句将其更改为1：

Option Base 1

放置在模块的顶部。如果模块中有这样的语句，则所有尚未声明其较低索引的数组都将从1中索引。

好的做法是始终指定数组的两个索引，因为您永远不知道您的Sub/函数是否会移动到另一个模块。而且，即使您的数组是从0索引的，这个新模块也可以有Option Base 1，并且可以从1而不是0索引数组。

我想这发生在您的代码中。

下面是您应该如何更改它：

Sub SelectSimilarshapes()
    Dim sh As Shape
    Dim shapeCollection() As String
    Dim otherShape As Shape
    Dim iShape As Integer


    Set sh = ActiveWindow.Selection.ShapeRange(1)
    ReDim Preserve shapeCollection(0 To 0)
    shapeCollection(0) = sh.Name
    iShape = 1

    For Each otherShape In ActiveWindow.View.Slide.Shapes
        If otherShape.Type = sh.Type _
            And otherShape.AutoShapeType = sh.AutoShapeType _
            And otherShape.Type <> msoPlaceholder Then

            If (otherShape.Name <> sh.Name) Then
                ReDim Preserve shapeCollection(0 To 1 + iShape)
                shapeCollection(iShape) = otherShape.Name
                iShape = iShape + 1
            End If

        End If
    Next otherShape
    ActiveWindow.View.Slide.Shapes.Range(shapeCollection).Select


    Select Case iShape
        Case 1
            MsgBox "Sorry, no shapes matching your search criteria were found"
        Case Else
            MsgBox "Shapes matching your search criteria were found and are selected"
    End Select

NormalExit:
    Exit Sub

err1:
    MsgBox "You haven't selected any object"
    Resume NormalExit:
End Sub