Resizing imported PowerPoint slides

[ctrhippie]

I have projects where I import PowerPoint slides into a table no Word.

One slide per row.

In order to fit our standardized format, I have to resize the slides (shrink
them down). I currently do this by resizing each slide one at a time. Is
there any way to select all the slides in a tabe at once and resize them?

 

[ctrhippie]

Let me clear this up a bit. I import the slide INTO word.

I'm trying to figure out how to resize all the imported slides at once
reather than going to each table cell and resizing.

(Next time I'll proof-read my question!)

 

[Jean-Guy Marcil]

Let me clear this up a bit. I import the slide INTO word.

I'm trying to figure out how to resize all the imported slides at once
reather than going to each table cell and resizing.

I assume that the PowerPoint objects are inline with text in the cells. If
that is the case, use this macro. Just change "sngNewHeight" to the value (in
inches) that you need for the height of the slides in Word. In this code the
value is 2.5 inches.

Sub ResizePowerPoint()

Dim tblPower As Table
Dim rgeTable As Range
Dim inshpPower As InlineShape
Dim sngOldHeight As Single
Const sngNewHeight As Single = 2.5

If ActiveDocument.Tables.Count > 0 Then
For Each tblPower In ActiveDocument.Tables
Set rgeTable = tblPower.Range
If rgeTable.InlineShapes.Count > 0 Then
For Each inshpPower In rgeTable.InlineShapes
With inshpPower
sngOldHeight = .Height
.Height = InchesToPoints(sngNewHeight)
.Width = InchesToPoints(((.Width * sngNewHeight) /
sngOldHeight))
End With
Next
End If
Next
Else
MsgBox "There are no tables in this document.", _
vbExclamation, "Cancelled"
End If

End Sub

 

[DeanH]

This is a nippy bit of maco.
One question, how would it look if it changed the size of multiple images
not in a table?
Many thanks
DeanH

 

[Jean-Guy Marcil]

This is a nippy bit of maco.
One question, how would it look if it changed the size of multiple images
not in a table?
Many thanks

Something like this (untested).
But this only works on inlinehapes. You would need another routine if you
also have floating shapes. Of course, if you only have floating shapes, you
would need different code.


Sub ResizePowerPoint()

Dim inshpPower As InlineShape
Dim sngOldHeight As Single
Const sngNewHeight As Single = 2.5

With ActiveDocument
If .InlineShapes.Count > 0 Then
For Each inshpPower In .InlineShapes
With inshpPower
sngOldHeight = .Height
.Height = InchesToPoints(sngNewHeight)
.Width = InchesToPoints(((.Width * sngNewHeight) /
sngOldHeight))
End With
Next
Else
MsgBox "There are no shapes in this document.", _
vbExclamation, "Cancelled"
End If
End With

End Sub

 

[DeanH]

Many thanks for this.
As I don't often use floating shapes, I don't foresee any problems.
I shall have a play later.
Thanks again.
DeanH

 

[DeanH]

This works perfectly.
I swapped the Height and Width as I want the width to be the controlling
factor.
Also changed the InchesToPoints to CentimetersToPoints, no problems at all.
Many thanks Jean-Guy.
Have a nice day.
DeanH

 

[Jean-Guy Marcil]

This works perfectly.
I swapped the Height and Width as I want the width to be the controlling
factor.
Also changed the InchesToPoints to CentimetersToPoints, no problems at all.
Many thanks Jean-Guy.
Have a nice day.

Glad I could help... you too! (have a nice day)