Error on copy and paste to powerpoint

[macroppt123]

Hi,

The copy paste works but I get an error that "Item with the specified name was not found."

In Debug mode the chart_name is assigned a chart title "VA Corres 10Q1"

Each chart has a chart title.

Below is the code and I have charts in an excel sheet.

Also the chart contained in the sheet "VA Chart Data Corres" is not being pasted. Not sure why.

I tried modifying the sheet to replace my charts but the code still ignores my chart and copies whatever was previously being copied.

Public Function copy_chart(sheet, chart_name, slide, aheight, awidth, atop, aleft, lockaspect, vscale)
Sheets(sheet).Select
' Set a VBE reference to Microsoft PowerPoint Object Library
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.slide
Dim shp As Shape
' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide
PPApp.ActiveWindow.View.GotoSlide (slide)
' Reference active slide
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
ActiveSheet.ChartObjects(chart_name).Activate
ActiveChart.ChartArea.Copy
PPSlide.Select
PPSlide.Shapes.PasteSpecial ppPastePNG
PPSlide.Select
PPSlide.Shapes(PPSlide.Shapes.COUNT).Select
Dim sr As PowerPoint.ShapeRange
Set sr = PPApp.ActiveWindow.Selection.ShapeRange
' Resize:
sr.Width = awidth
sr.Height = aheight
sr.LockAspectRatio = lockaspect

If sr.Width > 500 Then
sr.Width = 320
End If
If sr.Height > 420 Then
sr.Height = 420
End If
'sr.ScaleHeight 0.9, msoFalse
sr.ScaleWidth vscale, msoFalse
' Realign:
sr.Align msoAlignCenters, True
sr.Align msoAlignMiddles, True
sr.Top = atop
If aleft <> 0 Then
sr.Left = aleft
End If
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Function



Public Function add_slide()
' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
'create new slide
PPApp.Activate
PPPres.Slides.AddSlide PPPres.Slides.COUNT + 1, PPPres.SlideMaster.CustomLayouts(2)
End Function

Sub Copy2PowerPoint()
Application.ScreenUpdating = False
Dim slidenum As Integer
Dim PPTM As PowerPoint.Application
Set PPTM = New PowerPoint.Application
PPTM.Visible = True
PPTM.Presentations.Open Filename:="F:\Focus\Copy Paste Project\Competitive_blank_Version.pptm"


slidenum = 52
'Total Agency
'copy_chart(sheet, chart_name, slide, aheight, awidth, atop, aleft,lockaspect,vscale)
copy_chart "FHA Charts", "Retail", slidenum, 185, 180, 290, 195, msoFalse, 1.05
slidenum = 62
'Total Agency
'copy_chart(sheet, chart_name, slide, aheight, awidth, atop, aleft,lockaspect,vscale)
copy_chart "FHA Charts", "Corres", slidenum, 185, 180, 290, 195, msoFalse, 1.05
'slidenum = 81
'Total Agency
'copy_chart(sheet, chart_name, slide, aheight, awidth, atop, aleft,lockaspect,vscale)
'copy_chart "VA Charts", "Retail", slidenum, 185, 180, 290, 195, msoFalse, 1.05
slidenum = 87
'Total Agency
'copy_chart(sheet, chart_name, slide, aheight, awidth, atop, aleft,lockaspect,vscale)
copy_chart "VA Charts", "Corres", slidenum, 185, 180, 290, 195, msoFalse, 1.05
'slidenum = 90
'Total Agency
'copy_chart(sheet, chart_name, slide, aheight, awidth, atop, aleft,lockaspect,vscale)
'copy_chart "VA Charts", "Corres", slidenum, 185, 180, 290, 195, msoFalse, 1.05

Application.ScreenUpdating = True
End Sub


Thanks for your help

Best Regards,
macroppt123

[macroppt123]

For some reason, the slides are incremneted by 5. I do not see this in the code.

I have used somebody's code and am tweaking the same. The slide index starts at slide number 22 and increments by 5.

The code copies into a blank powerpoint file. There are exactly 22 slides and the copy of charts is in slides 3-7, 8-12, 13-17 and 18-22.

I cannot figure out in the code why the error message occurs and why the chart that I nwant to copy is not being pasted.

Best Regards,
macroppt123

I have to get this to work urgently.