Loop Macros

  • Thread starter Thread starter Nikki
  • Start date Start date
N

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.
 
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
 
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?
 
change to

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

Dont forget to Dim lngnum as Long
 
Back
Top