Powerpoint VBA to select all shapes within a specific area of the slide

Question

I want to run a macro in powerpoint that allows for the following steps:

1. For every slides in the active presentation, select an area of the slide within the size dimensions
2. Group all the objects (shapes, text boxes etc) but don't group images (emf, jpg, png) within the size dimensions
3. Ungroup

I'm new to ppt vba. After doing some research so far I have one created for a selected object(s) on each of the slide.

Appreciate the help!

Public Sub ResizeSelected()
On Error Resume Next
Dim shp As Shape

If ActiveWindow.Selection.Type = ppSelectionNone Then
  MsgBox "select a grouped", vbExclamation, "Make Selection"
Else
  Set shp = ActiveWindow.Selection.ShapeRange(1)

With ActiveWindow.Selection.ShapeRange
 .Width = 12.87
 .Left = 0.23
 .Ungroup
End With
End If
End Sub

Answer 1

You can probably work out changing the size, ungrouping and showing the messagebox on your own. This will help select and group the shapes. Change the values you pass to IsWithinRange as appropriate to your needs, add more shape types to the case selector if you like; I just added a few typical types. You definitely want to exclude Placeholders, Tables and such, since they can't be grouped with other shapes.

Sub Thing()
    Dim oSl As Slide
    Dim oSh As Shape

    For Each oSl In ActivePresentation.Slides
        For Each oSh In oSl.Shapes
            If IsWithinRange(oSh, 0, 0, 200, 200) Then
                ' Don't select certain shapes:
                Select Case oSh.Type
                    Case 1, 6, 9
                        ' add the shape to the selection
                        oSh.Select (False)
                    Case Else
                        ' don't include it
                End Select
            End If
        Next
        ActiveWindow.Selection.ShapeRange.Group
    Next
End Sub

Function IsWithinRange(oSh As Shape, _
    sngLeft As Single, sngTop As Single, _
    sngRight As Single, sngBottom As Single) As Boolean
' Is the shape within the coordinates supplied?

    With oSh
        Debug.Print .Left
        Debug.Print .Top
        Debug.Print .Left + .Width
        Debug.Print .Top + .Height
        If .Left > sngLeft Then
            If .Top > sngTop Then
                If .Left + .Width < sngRight Then
                    If .Top + .Height < sngBottom Then
                        IsWithinRange = True
                    End If
                End If
            End If
        End If
    End With

End Function

Answer 2

Dim oSl As Slide
Dim oSh As Shape

For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
  If IsWithinRange(oSh, -1, 0.5, 13.5, 7.4) Then
    ' Don't select certain shapes:
    Select Case oSh.Type
    Case msoGroup, msoChart, msoAutoShape, msoLine, msoDiagram, msoEmbeddedOLEObject
  ' add the shape to the selection
    oSh.Select (False)
    Case Else
    ' don't include it
    End Select
   End If
   Next
   ActiveWindow.Selection.ShapeRange.Group.Select

Next oSl
End Sub

Function IsWithinRange(oSh As Shape, _
sngLeft As Single, sngTop As Single, _
sngRight As Single, sngBottom As Single) As Boolean
' Is the shape within the coordinates supplied?

With oSh
    Debug.Print .Left
    Debug.Print .Top
    Debug.Print .Left + .Width
    Debug.Print .Top + .Height
    If .Left > sngLeft Then
        If .Top > sngTop Then
            If .Left + .Width < sngRight Then
                If .Top + .Height < sngBottom Then
                    IsWithinRange = True
                End If
            End If
        End If
    End If
 End With
End Function

Answer 3

Remember location and size of shapes are given in font points (72 pts / inch). If these are in inches "IsWithinRange(oSh, -1, 0.5, 13.5, 7.4)," try IsWithinRange(oSh, -72, 36, 98, 533).