macroppt123
05-31-2011, 01:05 PM
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
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