Solved

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

Posted on 2015-01-18
7
383 Views
Last Modified: 2015-01-28
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
0
Comment
Question by:Cadberry
7 Comments
 
LVL 45

Expert Comment

by:aikimark
Comment Utility
0
 
LVL 48

Assisted Solution

by:Rgonzo1971
Rgonzo1971 earned 167 total points
Comment Utility
Hi,

pls try

oshp.ScaleWidth dblscaleamount, msoFalse, msoScaleFromMiddle

Regards
0
 
LVL 23

Assisted Solution

by:JSRWilson
JSRWilson earned 167 total points
Comment Utility
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
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 9

Accepted Solution

by:
Jamie Garroch earned 166 total points
Comment Utility
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
 
LVL 23

Expert Comment

by:JSRWilson
Comment Utility
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
 
LVL 9

Expert Comment

by:Jamie Garroch
Comment Utility
Glad it's not just me JSRWilson!
0
 

Author Closing Comment

by:Cadberry
Comment Utility
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

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

This article shows how to simulate drawing numbers or names from a hat or bag using vba in PowerPoint and prevents duplicate items being selected. It’s not difficult to choose a (semi) random number in vba. The RND function returns a decimal numb…
 Regular Expressions Microsoft Word has sophisticated search tools that can search for patterns. For example if you wanted to search for all UK phone numbers that followed a pattern of five digits, a space and then six digits you can easily do th…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This video teaches viewers how to fit pictures into slides, crop and remove backgrounds, and alter photos to look more professional.

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now