Controlling powerpoint from excel

[tommy1234]

Hello
i wrote a code that create a new power point presentation and then copy an excel range of cells to a slide.
i want to add animation to the object (it copy as a picture to the presentation) . The animation effect is ' msoAnimEffectSpin ' and i want to define also the Effect Parameters Amount.

help is needed

Thank you

Sub Copy_Paste_to_PowerPoint()

Dim ppApp As PowerPoint.Application
Dim ppSlide As PowerPoint.Slide

Dim i As Integer
Dim SheetName As String
Dim TestRange As Range
Dim TestSheet As Worksheet
Dim TestChart As ChartObject

Dim PasteChart As Boolean
Dim PasteChartLink As Boolean
Dim ChartNumber As Long

Dim PasteRange As Boolean
Dim RangePasteType As String
Dim rangename1 As String
Dim AddSlidesToEnd As Boolean

SheetName = ActiveSheet.Name

'no chart will be paste
PasteRange = True
rangename1 = "page"
RangePasteType = "HTML"
RangeLink = False

PasteChart = False
PasteChartLink = False
'ChartNumber = 1

AddSlidesToEnd = True


'Error testing
On Error Resume Next
Set TestSheet = Sheets(SheetName)
Set TestRange = Sheets(SheetName).Range(rangename1)
Set TestChart = Sheets(SheetName).ChartObjects(ChartNumber)
On Error GoTo 0

If TestSheet Is Nothing Then
MsgBox "Sheet " & SheetName & " does not exist. Macro will exit", vbCritical
Exit Sub
End If

If PasteRange And TestRange Is Nothing Then
MsgBox "Range " & rangename1 & " does not exist. Macro will exit", vbCritical
Exit Sub
End If


'Look for existing instance
On Error Resume Next
Set ppApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0

'Create new instance if no instance exists
If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application
'Add a presentation if none exists
If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Add

'Make the instance visible
ppApp.Visible = True
ppApp.ActivePresentation.ApplyTemplate Filename:="C:\Program Files\Microsoft Office\Templates\Presentation Designs\status.pot"
ppApp.ActivePresentation.PageSetup.SlideOrientation = msoOrientationVertical
Set ppSlide = ppApp.ActivePresentation.Slides.Add(1, ppLayoutTitle)

'Check that a slide exits, if it doesn't add 1 slide. Else use the last slide for the paste operation
If ppApp.ActivePresentation.Slides.Count = 0 Then
Set ppSlide = ppApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
Else
If AddSlidesToEnd Then
'Appends slides to end of presentation and makes last slide active
ppApp.ActivePresentation.Slides.Add ppApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
ppApp.ActiveWindow.View.GotoSlide ppApp.ActivePresentation.Slides.Count
Set ppSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count)
Else
'Sets current slide to active slide
Set ppSlide = ppApp.ActiveWindow.View.Slide
End If
End If

' Copy and Paste range
Worksheets("target").Activate
[a1].Select
'Paste Range as Picture
Worksheets(SheetName).Range(rangename1).Copy
ppSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile, msoFalse).Select
'paste picture size
ppApp.ActiveWindow.Selection.ShapeRange.Height = 720
ppApp.ActiveWindow.Selection.ShapeRange.Width = 550
'horizental position
ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
'vertical position
ppApp.ActiveWindow.Selection.ShapeRange.IncrementTop IncrementTop + 330


AppActivate ("Microsoft PowerPoint")
Dim templ As String
Set ppSlide = Nothing
Set ppApp = Nothing

End Sub

[tommy1234]

I see that no one has answer, is it right ?