Rotate all images on all slides in PPT

Member_2_7966563
Member_2_7966563 used Ask the Experts™
on
I scanned 100 A3 pages into a PPTX file and then shredded them. When I looked at the file, all slides are in landscape format, while I needed them in portrait.

What would be the quickest way to rotate all 100 scanned images on all 100 slides by 90 degrees?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Karen FalandaysTraining Specialist

Commented:
Are the slides landscape or the images? If it is the slides, you can navigate to Design>Slide size and change to the desired layout
Jamie GarrochSenior Technical Consultant at BrightCarbon

Commented:
You can do this very quickly using a bit of PowerPoint VBA code (if you don't know what to do with it, check out my article here).

Option Explicit

' ==============================================
' PowerPoint VBA Macro (runs in the PPT VBE)
' Written by : Jamie Garroch of YOUpresent Ltd.
' Date : 25 OCT 2018
' http://youpresent.co.uk/
' ==============================================
Public Sub RotateAllPictures90()
  Dim oSld As Slide
  Dim oShp As Shape
  
  ' Change to -90 if you need it to go the other way
  Const ROTATION_ANGLE = 90
  
  On Error GoTo errorhandler
  
  ' Process all slides across the active presentation
  For Each oSld In ActivePresentation.Slides
    ' Process all objects on each slide (assumes pictures are not part of a group)
    For Each oShp In oSld.Shapes
      Select Case oShp.Type
        ' Process picture objects only, assuming they are not in placeholders
        Case msoPicture, msoLinkedPicture
          oShp.Rotation = oShp.Rotation + ROTATION_ANGLE
        Case Else ' do nothing
      End Select
    Next
  Next
  
Exit Sub

errorhandler:
  Debug.Print Err, Err.Description
End Sub

Open in new window

Author

Commented:
Hi Jamie, thanks a lot! This is what I was looking for, and it worked out-of-the-box (did what it was intended to do).

After running the code I realised that the scanner machine did more than just scan each page and put it into the PPT one image per slide. It actually broke the page into multiple pieces, and stitched them together on the PPT slide. I have no idea what logic it used. Basically they are several images with transparent backgrounds laid on top of each other. Together, they build the original on the scanned page.

So now, I need they routine to build the original image (I guess by Grouping all the images on one slide) before rotating the entire Group.

Could you please help?
PMI ACP® Project Management

Prepare for the PMI Agile Certified Practitioner (PMI-ACP)® exam, which formally recognizes your knowledge of agile principles and your skill with agile techniques.

Senior Technical Consultant at BrightCarbon
Commented:
That's a little bit more complicated but this works with my test deck containing multiple slides of one, mnay images, with an without placeholders:

Option Explicit
Option Base 1

' ==============================================
' PowerPoint VBA Macro (runs in the PPT VBE)
' Written by : Jamie Garroch of YOUpresent Ltd.
' Date : 25 OCT 2018
' http://youpresent.co.uk/
' ==============================================
Public Sub RotateAllPictures90()
  Dim oSld As Slide
  Dim oShp As Shape, oPics As Shape
  Dim aPics() As String ' Array pf picture names
  Dim lPics As Long ' Number of pictures in the array
  
  ' Change to -90, 180 or 270 depending on how the pictures are originally rotated
  Const ROTATION_ANGLE = 90
  
  On Error GoTo errorhandler
  
  ' Process all slides across the active presentation
  For Each oSld In ActivePresentation.Slides
    ' Get an array of all picture objects
    aPics = GetArrayOfPictures(oSld)
    ' Test if array is allocated and if no error, group and rotate the pictures
    On Error Resume Next
    lPics = UBound(aPics)
    If Err = 0 Then
        On Error GoTo 0
      If lPics = 1 Then ' ony one picture found
        ' Set a reference to the one picture specified by the array
        Set oPics = oSld.Shapes.Range(aPics(1))(1)
      Else
        ' Group the pictures specified by the array
        Set oPics = oSld.Shapes.Range(aPics).Group
      End If
      ' Rotate the object (which may actually be 1 shape or a group of shapes)
      oPics.Rotation = oPics.Rotation + ROTATION_ANGLE
    End If
  Next
  
Exit Sub

errorhandler:
  Debug.Print Err, Err.Description
End Sub

' Returns an array of shape names for all picture objects on the slide
Private Function GetArrayOfPictures(oSld As Slide) As Variant
  Dim oShp As Shape
  Dim aPics() As String
  Dim lIdx As Long
  
  ' Process all objects on this slide (assumes pictures are not part of a group)
  For Each oShp In oSld.Shapes
      Select Case oShp.Type
        ' Process picture objects only, assuming they are not in placeholders
        Case msoPicture, msoLinkedPicture
          lIdx = lIdx + 1
          ReDim Preserve aPics(lIdx)
          aPics(lIdx) = oShp.Name
        Case Else ' do nothing
      End Select
  Next
  
  GetArrayOfPictures = aPics
End Function

Open in new window

Author

Commented:
That worked like a charm. I had to add two more rows to take care of the Scaling between 38 and 39:

      oPics.ScaleHeight Scaling, msoFalse, msoScaleFromMiddle
      oPics.ScaleWidth Scaling, msoFalse, msoScaleFromMiddle

and

Dim Scaling As Double

between 11 and 12
Jamie GarrochSenior Technical Consultant at BrightCarbon

Commented:
Great. Glad it worked. Strange things that the scanner was doing! Perhaps exporting to a layered format such as EPS but that format has been disabled for security reasons by Microsoft in the latest versions of Office so not sure what was going on.
AlanConsultant

Commented:
Pro-Tips:

1) Don't scan to Powerpoint - Scan to an image format, then import to whatever you need.

2) Don't shred the originals until you are sure you have a good scan - throw them in a 'shred next year' bin if you are prone to recklessness!

:-P

Alan.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial