How do I resize images using vba code (powerpoint 2010) so they are center scaled?

I've written vba code to reduce the width of all images in a deck by 25%. But they default to reducing these images by the right side. How can I incorporate into my code that the images scale back 25% from their center and not the right side. I know there is a vba term ScaleFromMiddle but don't know how to incorporate it into my code.
Thank you.

Sub Scale()
Dim Sl As Slide
Dim Sh As Shape
For Each Sl In ActivePresentation.Slides
    For Each Sh In Sl.Shapes
        Sh.LockAspectRatio = False
    Next
Next
Dim oshp As Shape
Dim osld As Slide
Dim dblscaleamount As Double

dblscaleamount = 0.75
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.Type = msoPicture Or _
   oshp.Type = msoChart Or _
   oshp.Type = msoTable Or _
   oshp.Type = msoAutoShape Or _
   oshp.Type = msoGroup Then
oshp.width = oshp.width * dblscaleamount
oshp.Height = oshp.Height
End If
Next oshp
Next osld
End Sub
CadberryAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
Jamie GarrochConnect With a Mentor PowerPoint Consultant & DeveloperCommented:
In addition, I get a compile error with the procedure name so putting it all together:

Option Explicit

' Scale all shapes from their centres in all slides in the current presenation
Sub ScaleShapes()
  Dim oSld As Slide
  Dim oShp As Shape
  Dim sScale As Single
  
  sScale = 0.75
  
  For Each oSld In ActivePresentation.Slides
    For Each oShp In oSld.Shapes
      With oShp
        If .Type = msoPicture Or _
           .Type = msoChart Or _
           .Type = msoTable Or _
           .Type = msoAutoShape Or _
           .Type = msoGroup Then
              .LockAspectRatio = msoTrue
              .ScaleWidth sScale, msoFalse, msoScaleFromMiddle
        End If
      End With
    Next
  Next
End Sub

Open in new window

0
 
Rgonzo1971Connect With a Mentor Commented:
Hi,

pls try

oshp.ScaleWidth dblscaleamount, msoFalse, msoScaleFromMiddle

Regards
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
JSRWilsonConnect With a Mentor Commented:
Just a slight addition to Rgonzo's good code

With oshp
    .LockAspectRatio = msoTrue
    .ScaleWidth dblscaleamount, msoFalse, msoScaleFromMiddle
End With

For images LockAspectRation True is the default but not for shapes where the default is False

Pedantic point Factor is a Single not a Double
0
 
JSRWilsonCommented:
Yep Scale is a vba reserved word like Print, Byte, Dim etc.

I have tries several times to get a full list but it doesn't seem to exist.
0
 
Jamie GarrochPowerPoint Consultant & DeveloperCommented:
Glad it's not just me JSRWilson!
0
 
CadberryAuthor Commented:
Thank you all! These are fantastic solutions.
I was being stubborn and trying to figure out how to have IncrementLeft = 12.5% of the image width as an alternative to ScaleFromMiddle but finally had to cede that it wasn't working.  Thank you all again and apologize for the delayed response.
0
All Courses

From novice to tech pro — start learning today.