vba to centre a shape on a powerpoint slide

[cjcass]

Hi,

I have the following code that selects an area in Excel then pastes it into powerpoint.


'Transition3
Sheet76.Select

Dim shp As Object
Dim sld As Object
Dim eff As Object


Const msoAnimEffectFade As Long = 10
Const msoAnimTriggerWithPrevious As Long = 2

Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation


ActiveSheet.Range("H113").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture 'excel range to be pasted
Set sld = PPPres.Slides("Transition3")
Set shp = sld.Shapes.Paste.Item(1)


'add fade effect to shape
Set eff = sld.TimeLine.MainSequence.AddEffect _
(Shape:=shp, effectid:=msoAnimEffectFade, Trigger:=msoAnimTriggerWithPrevious)

eff.Timing.Duration = 0.5
eff.Timing.TriggerDelayTime = 0

With shp
.LockAspectRatio = msoTrue
.ScaleHeight 0.47, msoTrue
.Left = 27
.Top = 56
.ZOrder msoSendToBack

End With


How do I change the .Left and .Top positioning so the shape is centred on the slide (after it has been re-scaled)..?

Hope you can help, many thanks

 

[pbornemeier]

This should work:

With shp
        .LockAspectRatio = msoTrue
        .ScaleHeight 0.47, msoTrue
        sngDefaultSlideWidth = PPPres.PageSetup.SlideWidth
        sngDefaultSlideHeight = PPPres.PageSetup.SlideHeight
        .Left = (sngDefaultSlideWidth - .Width) / 2
        .Top = (sngDefaultSlideHeight - .Height) / 2
        .ZOrder msoSendToBack
End With

 

[cjcass]

Works perfectly, thank you very much