VBA Powerpoint pour sélectionner toutes les formes dans une zone spécifique de la diapositive

Question

Je veux exécuter une macro dans Powerpoint qui permet les étapes suivantes :

1. Pour chaque diapositive de la présentation active, sélectionnez une zone de la diapositive dans les dimensions de la taille.
2. Regroupez tous les objets (formes, zones de texte, etc.) mais ne regroupez pas les images (emf, jpg, png) dans les dimensions de la taille.
3. Dégrouper

Je suis novice en matière de ppt vba. Après avoir fait quelques recherches jusqu'à présent, j'en ai créé un pour un ou plusieurs objets sélectionnés sur chacune des diapositives.

J'apprécie l'aide !

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

Vous pouvez probablement vous débrouiller tout seul pour modifier la taille, dégrouper et afficher la boîte à messages. Cela vous aidera à sélectionner et à regrouper les formes. Modifiez les valeurs que vous passez à IsWithinRange en fonction de vos besoins, ajoutez d'autres types de formes au sélecteur de cas si vous le souhaitez ; j'ai juste ajouté quelques types typiques. Vous voulez absolument exclure les Placeholders, les tableaux et autres, car ils ne peuvent pas être groupés avec d'autres formes.

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