CT Witter
MrExcel MVP
- Joined
- Jul 7, 2002
- Messages
- 1,212
Grabbed this code from this board but keep getting a code error. I have a referrence to MS PowerPoint 10.
Works fine if PPT is open, errors on the if to create a new presenation. Error is "Application (unknown member): Invalid request. There is no active presentation.
What do I need to do differently?
Thanks,
CT
Code:
Option Explicit
Sub MoveActiveChartToPPT()
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Dim strMsg As String
If TypeName(ActiveSheet) <> "Chart" Then
strMsg = "The wrong type of sheet is active."
MsgBox strMsg, vbExclamation
Exit Sub
End If
Dim appPPT As New PowerPoint.Application
Dim pptActive As PowerPoint.Presentation
Dim slideNew As Slide
Dim shpChart As PowerPoint.Shape, shpTitle As PowerPoint.Shape
Dim i%
On Error Resume Next
' Reference existing instance of PowerPoint
Set appPPT = GetObject(, "Powerpoint.Application")
If Err.Number <> 0 Then
' PowerPoint not running, create new instance
Set appPPT = CreateObject("Powerpoint.Application")
End If
On Error GoTo 0
Set pptActive = appPPT.ActivePresentation
Application.ScreenUpdating = False
Application.CutCopyMode = False
ActiveChart.ChartArea.Copy
With pptActive
Set slideNew = .Slides.Add(Index:=.Slides.Count + 1, _
Layout:=ppLayoutTitleOnly)
slideNew.Shapes.PasteSpecial ppPasteEnhancedMetafile
End With
Set shpChart = slideNew.Shapes(slideNew.Shapes.Count)
With shpChart
.Left = pptActive.PageSetup.SlideWidth * 0.05
.Top = 100
.Width = pptActive.PageSetup.SlideWidth * 0.9
' .ScaleWidth 1.22, msoFalse, msoScaleFromTopLeft
' .ScaleHeight 1.22, msoFalse, msoScaleFromTopLeft
End With
Set shpChart = Nothing
Set slideNew = Nothing
Set pptActive = Nothing
Set appPPT = Nothing
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Works fine if PPT is open, errors on the if to create a new presenation. Error is "Application (unknown member): Invalid request. There is no active presentation.
What do I need to do differently?
Thanks,
CT