0
votes

I would like to do the following in VBA powerPoint:

I have a powerPoint with six pictures on it. Ideally I would like to group the six pictures to create one new picture as a .jpg, then export the .jpg picture to a file. After exporting the photo, I would like to then delete the 6 individual pictures so I can import the single .jpg picture.

I have used this to start: Save all Shapes of slide into single JPG image . I understand the comment, but do not know how to execute it.

If there is a better way to do this, please share.

Thank you!

1
is this something that you only want to do one time? If so, no point in using VBA for it - Marcucciboy2
No it is for a large slide deck with the same layout for each slide - user9871028
What I mean is - will you only merge these pictures one time and never do this task again? - Marcucciboy2
yes, the pictures are coming from different sources and being formatted on the power point slide. Then grouped together to create one picture - user9871028
A simple way to export the picture as a jpg without using VBA would just be to copy and paste it into Paint. Then hit the crop button and save as .jpg - Marcucciboy2

1 Answers

0
votes

This will convert the currently selected shapes to a PNG, paste it back onto the slide and delete the original shapes.

You may want to modify this to ensure that something is selected and quit gracefully if not, or if it's just for your own use, let PPT/VBA scold you if you forget to select something.

Sub ConvertSelectionToImage()

    Dim oShapes As ShapeRange
    Dim oGroup As Shape
    Dim oSingleShape As Shape

    ' Get a reference to the selected shapes
    Set oShapes = ActiveWindow.Selection.ShapeRange
    ' Group them so we can later pick up their coordinates
    Set oGroup = oShapes.Group
    ' copy to clipboard
    oGroup.Copy

    ' paste from clipboard as PNG to retain transparency
    Set oSingleShape = ActiveWindow.Selection.SlideRange.Shapes.PasteSpecial(ppPastePNG)(1)

    ' Position the pasted PNG to match original shapes
    With oSingleShape
        .Left = oGroup.Left
        .Top = oGroup.Top
    End With

    ' And delete the original shapes
    oGroup.Delete

End Sub