電源點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，並suddenty您的數組索引從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