vbapowerpointpowerpoint-2013

Power Point VBA Macro: Run time error 9


I am facing the Run time error 9: Subscript out of range for the below code, But it worked fine initially. But later when i collaborate all the modules to create add-in, Its showing error.

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

Solution

  • When declaring or resizing arrays you should specify both lower and upper index for this array, for example

    ReDim Preserve shapeCollection(0 To 0)
    

    instead of

    ReDim Preserve shapeCollection(0)
    

    In other languages arrays are usually indexed from 0 and there is no exception.

    In VBA arrays can be indexed from any value, i.e.

    Dim array(5 To 10) As String
    

    If you skip the lower index it will have default value. The built-in default value is 0, but it can be changed to 1 with the following statement:

    Option Base 1
    

    placed at the top of a module. If there is such statement in the module, all arrays that have not declared their lower index, are indexed from 1.

    The good practice is to always specify both indexes of array, since you never know if your Sub/Function would be moved to another module. And even if your arrays were indexed from 0, this new module can have Option Base 1, and suddenty your arrays are indexed from 1 instead of 0.


    I suppose this happens in your code.

    Here is how you should change it:

    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