vba to assign animation to a picture transferred into powerpoint

[cjcass]

Hi,
I have the following vba that copy>pastes a worksheet range from excel into ppt as a picture. What code will then assign a Fade In animation to the picture?
Hope you can help, many thanks.

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


Sheet72.Range("G15:S37").CopyPicture Appearance:=xlScreen, Format:=xlPicture
PPPres.Slides(1).Shapes.Paste


With PPPres.Slides(1)
    With .Shapes(.Shapes.Count)
        .LockAspectRatio = msoTrue
        .ScaleHeight 0.8, msoTrue
        .Left = 27
        .Top = 121
    End With
End With

 

[cjcass]

can anyone help with this??

 

[RoryA]

Something like this I think:

    Dim shp                   As PowerPoint.Shape
    Dim sld                   As PowerPoint.Slide
    Dim eff                   As PowerPoint.Effect

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


    ActiveSheet.Range("G15:S37").CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Set sld = PPPres.Slides(1)
    Set shp = sld.Shapes.Paste.Item(1)

    'add fade effect to shape
    Set eff = sld.TimeLine.MainSequence.AddEffect _
              (Shape:=shp, effectid:=msoAnimEffectFade, trigger:=msoAnimTriggerOnPageClick)
    ' medium speed (2 secs)
     eff.Timing.Duration = 2
     
    With shp
        .LockAspectRatio = msoTrue
        .ScaleHeight 0.8, msoTrue
        .Left = 27
        .Top = 121
    End With

 

[cjcass]

Hi,
Thanks for your help with this, however ran into a problem - the macro stops at the first line and I get 'Compile error: User-defined type not defined'
Any thoughts?
Rgds

 

[RoryA]

If you're late-binding your code, you'll need to alter what I posted accordingly:

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

    Const msoAnimEffectFade As Long = 10
    Const msoAnimTriggerOnPageClick As Long = 1
    
    Set PPApp = GetObject(, "Powerpoint.Application")
    Set PPPres = PPApp.ActivePresentation


    ActiveSheet.Range("G15:S37").CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Set sld = PPPres.Slides(1)
    Set shp = sld.Shapes.Paste.Item(1)

    'add fade effect to shape
    Set eff = sld.TimeLine.MainSequence.AddEffect _
              (Shape:=shp, effectid:=msoAnimEffectFade, trigger:=msoAnimTriggerOnPageClick)
    ' medium speed (2 secs)
     eff.Timing.Duration = 2
     
    With shp
        .LockAspectRatio = msoTrue
        .ScaleHeight 0.8, msoTrue
        .Left = 27
        .Top = 121
    End With

 

[cjcass]

Hi, That works great thanks very much.
Just one final quick question though if I may - what's the code to have the fade in 'after previous' as opposed to 'on click'?
Thanks

 

[RoryA]

Add:

Const msoAnimTriggerAfterPrevious As Long = 3

and then use that constant instead of msoAnimTriggerOnPageClick

 

[cjcass]

Excellent!
Thanks you have been most helpful

 

[cjcass]

Hi,
Have just come across another requirement if possible - is there some code that will put the pasted shape to the back on the ppt slide, ie. code to execute 'Send to Back'?
Rgds

 

[cjcass]

ok, have sussed it... just add .ZOrder msoSendToBack after the sizing of the shape.