freebirdwr
New Member
- Joined
- Jul 18, 2008
- Messages
- 15
- Office Version
- 365
- Platform
- Windows
Good morning.
I am trying to paste a series of Excel charts to PowerPoint. The script I am using worked for the first 2 charts and then bombed on the next 5. I closed everything and reopened the PowerPoint and ran it again. It bombed on the first one and ran 2 and 3 successfully. I don't have a clue what is going on. I know from reading posts that the Excel - PowerPoint pasting is quirky and now I see it. Bombs on Line 12 (wb.Sheets(sheetName).ChartObjects(chartName).Copy). Thanks.
Scott
I am trying to paste a series of Excel charts to PowerPoint. The script I am using worked for the first 2 charts and then bombed on the next 5. I closed everything and reopened the PowerPoint and ran it again. It bombed on the first one and ran 2 and 3 successfully. I don't have a clue what is going on. I know from reading posts that the Excel - PowerPoint pasting is quirky and now I see it. Bombs on Line 12 (wb.Sheets(sheetName).ChartObjects(chartName).Copy). Thanks.
Scott
Code:
Function CopyChartFromExcelToPPT(excelFilePath As String, sheetName As String, chartName As String, dstSlide As Long, Optional shapeTop As Long, Optional shapeLeft As Long)
On Error GoTo ErrorHandl 'Handle Errors
'Set Variables and Open Excel
Dim eApp As Excel.Application, wb As Excel.Workbook, ppt As PowerPoint.Presentation, ws As Excel.Worksheet
Set eApp = New Excel.Application
eApp.Visible = True
Set wb = eApp.Workbooks.Open(excelFilePath)
Set ppt = ActivePresentation
'Copy Chart in Excel
wb.Sheets(sheetName).ChartObjects(chartName).Copy
DoEvents
'Paste into first slide in active PowerPoint presentation
ppt.Slides(dstSlide).Shapes.PasteSpecial ppPasteBitmap
'Close and clean-up Excel
wb.Close SaveChanges:=False
eApp.Quit
Set wb = Nothing: Set eApp = Nothing
'Move the new shape if left/top provided
If Not (IsMissing(shapeTop)) Then
With ppt.Slides(dstSlide).Shapes(ppt.Slides(dstSlide).Shapes.Count)
.Left = shapeLeft
.Top = shapeTop
End With
End If
'CopyChartFromExcelToPPT = True
Exit Function
ErrorHandl:
'Make sure to close the workbook and Excel and return False
On Error Resume Next
If Not (eApp Is Nothing) Then
wb.Close SaveChanges:=False
eApp.Quit
End If
'CopyChartFromExcelToPPT = False
End Function
Sub Test()
Call CopyChartFromExcelToPPT("C:\Desktop\EVMC_Charts 12-3-2019 in work.xlsm", "SAPivot", "cht404_SA", 2, 108, 0)
MsgBox "OK"
Call CopyChartFromExcelToPPT("C:\Desktop\EVMC_Charts 12-3-2019 in work.xlsm", "SAPivot", "chtGUMAAA_SA", 3, 108, 0)
MsgBox "OK"
Call CopyChartFromExcelToPPT("C:\Desktop\EVMC_Charts 12-3-2019 in work.xlsm", "SAPivot", "chtGUMAAB_SA", 4, 108, 0)
MsgBox "OK"
Call CopyChartFromExcelToPPT("C:\Desktop\EVMC_Charts 12-3-2019 in work.xlsm", "SAPivot", "chtGUMABA_SA", 5, 108, 0)
MsgBox "OK"
Call CopyChartFromExcelToPPT("C:\Desktop\EVMC_Charts 12-3-2019 in work.xlsm", "SAPivot", "chtGUMABB_SA", 6, 108, 0)
MsgBox "OK"
Call CopyChartFromExcelToPPT("C:\Desktop\EVMC_Charts 12-3-2019 in work.xlsm", "SAPivot", "chtGUMABC_SA", 7, 108, 0)
MsgBox "OK"
Call CopyChartFromExcelToPPT("C:\Desktop\EVMC_Charts 12-3-2019 in work.xlsm", "SAPivot", "chtGUMABD_SA", 8, 108, 0)
MsgBox "OK"
End Sub