A macro needed to crop to fit all images at once

shaivya1998 · #1 08-13-2015, 10:39 AM

Anyone who is good with macros can create a macro for me in PowerPoint 2013 which will crop to fit all images on the slide at once. Please mention the steps of doing that if possible (even the naming part of macros).

JohnWilson · #2 08-14-2015, 02:36 AM

Explain a little more what you need.

Are the pictures in PICTURE Placeholders?
Just one slide or all slides need to be cropped?
Anything other useful info?

shaivya1998 · #3 08-14-2015, 02:45 AM

Quote:

Originally Posted by JohnWilson

Explain a little more what you need.

Are the pictures in PICTURE Placeholders?
Just one slide or all slides need to be cropped?
Anything other useful info?

I am using a picture layout to rearrange different logos of companies. I want to crop to fit them in only one slide.

JohnWilson · #4 08-14-2015, 03:10 AM

Not sure I really understand but maybe

Code:

Sub cropFit()
Dim osld As Slide
Dim oshp As Shape
On Error Resume Next
Set osld = ActiveWindow.View.Slide
If Not osld Is Nothing Then
For Each oshp In osld.Shapes
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.Type = ppPlaceholderPicture Then
oshp.Select
CommandBars.ExecuteMso ("PictureFitCrop")
End If 'picture placeholder
End If 'placehoder
Next oshp
End If ' Slide selected
End Sub

shaivya1998 · #5 08-14-2015, 03:27 AM

Quote:

Originally Posted by JohnWilson

Not sure I really understand but maybe

Code:

Sub cropFit()
Dim osld As Slide
Dim oshp As Shape
On Error Resume Next
Set osld = ActiveWindow.View.Slide
If Not osld Is Nothing Then
For Each oshp In osld.Shapes
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.Type = ppPlaceholderPicture Then
oshp.Select
CommandBars.ExecuteMso ("PictureFitCrop")
End If 'picture placeholder
End If 'placehoder
Next oshp
End If ' Slide selected
End Sub

It isn't working with picture layouts.

JohnWilson · #6 08-14-2015, 03:34 AM

It does but you are not explaining clearly exactly what you mean.

Maybe post a sample slide and explain what you want to happen to it.

shaivya1998 · #7 08-14-2015, 03:51 AM

Quote:

Originally Posted by JohnWilson

It does but you are not explaining clearly exactly what you mean.

Maybe post a sample slide and explain what you want to happen to it.

https://goo.gl/photos/57Lt6gbgkiY6AGiy7

JohnWilson · #8 08-14-2015, 07:34 AM

A photo isn't really a sample of the slide but at least I can see you mean a Smart Art layout.

Make sure the Smart Art is selected and try this - USE A COPY!

Code:

Sub chexSA()
Dim osa As SmartArt
Dim osld As Slide
On Error Resume Next
Dim i As Integer
Set osa = ActiveWindow.Selection.ShapeRange(1).SmartArt
For i = 1 To osa.AllNodes.Count
osa.AllNodes(i).Shapes(2).Select
CommandBars.ExecuteMso ("PictureFitCrop")
Next
End Sub

shaivya1998 · #9 08-14-2015, 08:11 AM

Quote:

Originally Posted by JohnWilson

A photo isn't really a sample of the slide but at least I can see you mean a Smart Art layout.

Make sure the Smart Art is selected and try this - USE A COPY!

Code:

Sub chexSA()
Dim osa As SmartArt
Dim osld As Slide
On Error Resume Next
Dim i As Integer
Set osa = ActiveWindow.Selection.ShapeRange(1).SmartArt
For i = 1 To osa.AllNodes.Count
osa.AllNodes(i).Shapes(2).Select
CommandBars.ExecuteMso ("PictureFitCrop")
Next
End Sub

Thanks man it worked. Really thanks....

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Help Creating Macro to Crop/Resize Images	ineedmacrohelp	Word VBA	1	08-06-2015 06:46 AM
*help* macro needed	PokerBob	Excel	8	03-18-2015 02:57 PM
Macro Needed to bold specific lines and Macro to turn into CSV	anewteacher	Word VBA	1	05-28-2014 03:59 PM
Check box macro help needed	Aflac	Word	4	03-24-2012 07:11 PM
Callout macro needed - Help please	Peter Denly	Word VBA	19	07-20-2011 03:30 AM