0

我面临运行时错误 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
4

1 回答 1

0

在声明或调整数组大小时，您应该为该数组指定下标和上标，例如

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 开始索引。

好的做法是始终指定数组的两个索引，因为您永远不知道您的子/函数是否会移动到另一个模块。即使你的数组​​是从 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
于 2015-12-21T11:13:43.663 回答