Power Point 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/Function 是否会被移动到另一个模块。即使你的数组是从 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

Power Point VBA 宏：运行时间错误 9

Power Point VBA Macro: Run time error 9

powerpoint

vba

powerpoint-2013

Power Point VBA 宏：运行 时间错误 9

Power Point VBA Macro: Run time error 9

powerpoint

vba

powerpoint-2013

Power Point VBA 宏：运行时间错误 9