Loop Macros

[Nikki]

Hi,

I have created a scale macro and 4 position macros for 4 pictures on
each slide. For the scale macro I can Select All 4 pictures and run
the macro to scale all at once but for the position macro I have to
select each picture one at a time. Then I have to go to the next
slide and do this all over again. Is there a way to run all 5 macros
with the current picture selected each time automatically?

The macros I have created already are:

Sub Scalepicture()
Set myDocument = ActivePresentation.Slides(1)
For Each s In myDocument.Shapes
Select Case s.Type
Case msoEmbeddedOLEObject, msoLinkedOLEObject, _
msoOLEControlObject, msoLinkedPicture, msoPicture
s.ScaleHeight 0.93, msoTrue
s.ScaleWidth 0.93, msoTrue
Case Else
s.ScaleHeight 0.93, msoFalse
s.ScaleWidth 0.93, msoFalse
End Select
Next

End Sub

Sub UpperLeft()
With ActiveWindow.Selection.ShapeRange
..Left = 20
..Top = 30
End With
End Sub

Sub LowerLeft()
With ActiveWindow.Selection.ShapeRange
..Left = 20
..Top = 250
End With
End Sub
Sub LowerRight()
With ActiveWindow.Selection.ShapeRange
..Left = 420
..Top = 250
End With
End Sub
Sub UpperRight()
With ActiveWindow.Selection.ShapeRange
..Left = 420
..Top = 30
End With
End Sub

Any help would be greatly appreciated.

 

[John Wilson]

Matbe this sort of thing. Select the shapes in the order top left, top right,
bottom left, bottom right

Option Explicit
Dim myslide As Slide
Dim s As Shape

Sub Scalepictureandmove()
On Error GoTo errhandler
If ActiveWindow.Selection.ShapeRange.Count <> 4 Then
MsgBox "You must select four shapes!"
Exit Sub
End If
Set myslide = ActivePresentation.Slides(1)
For Each s In myslide.Shapes
Select Case s.Type
Case msoEmbeddedOLEObject, msoLinkedOLEObject, _
msoOLEControlObject, msoLinkedPicture, msoPicture
s.ScaleHeight 0.93, msoTrue
s.ScaleWidth 0.93, msoTrue
Case Else
s.ScaleHeight 0.93, msoFalse
s.ScaleWidth 0.93, msoFalse
End Select
Next
With ActiveWindow.Selection.ShapeRange(1)
..Left = 20
..Top = 30
End With
With ActiveWindow.Selection.ShapeRange(2)
..Left = 420
..Top = 30
End With
With ActiveWindow.Selection.ShapeRange(3)
..Left = 20
..Top = 250
End With
With ActiveWindow.Selection.ShapeRange(4)
..Left = 420
..Top = 250
End With
Exit Sub
errhandler:
MsgBox "Error", vbCritical
End Sub

 

[Nikki]

Yes! Thank you so much. You just saved me a whole lot of time!!

 

[Nikki]

Actually - one question

Is there a way that I can change the
Set myslide = ActivePresentation.Slides(1)
To select the current slide. So if I am on slide 2 it will be
Set myslide = ActivePresentation.Slides(2)
without having to change it maually?

 

[John Wilson]

change to

lngnum = ActiveWindow.Selection.SlideRange.SlideIndex
Set myslide = ActivePresentation.Slides(lngnum)

Dont forget to Dim lngnum as Long