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、突然、配列は 0 ではなく 1 からインデックス付けされます。

これはあなたのコードで起こると思います。

変更方法は次のとおりです。

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 に答える