Is there a way such that i can copy and paste multiple charts that are grouped in four as shown below from excel to my existing powerpoint slides 28 and slides 29? The name of the groups are group 16 for the left group, group 17 for the right group. I have tried to use Chrt.CopyPicture but it only copies charts separately to the slides instead of a group like the one outline on the 4 charts shown on the left side of the picture below. By the way, my only code only copies charts individually to slide 28.
Sub ExportChartsTopptSingleWorksheet()
'Declare PowerPoint Variables
Dim PPTApp As Object
Dim PPTPres As Object
Dim PPTShape As Object
Dim mySlide, myslide2 As Object
'Declare Excel Variables
Dim Chrt As ChartObject
If PPTApp Is Nothing Then _
Set PPTApp = CreateObject(class:="PowerPoint.Application")
On Error GoTo 0
PPTApp.Visible = True
'Create new presentation in the PowerPoint application.
Set PPTPres = PPTApp.Presentations.Open(Filename:="\\fab2crp-nas1\home22\kkang2\Profile\Desktop\myassignment3\mypresentationsample.pptx")
Set mySlide = PPTPres.Slides.Add(28, 1)
'Loop through all the CHARTOBJECTS in the ACTIVESHEET.
For Each Chrt In ActiveSheet.ChartObjects
'Copy the Chart
Chrt.CopyPicture '<------ method copy fail error here
'paste all the chart on to exisitng ppt slide 28
mySlide.Shapes.Paste
Next Chrt
End Sub
Currently, charts are copied individually to ppt slides
Expected
This worked for me.
Sub ExportChartsTopptSingleWorksheet()
Const PER_ROW As Long = 2 'charts per row in PPT
Const T_START As Long = 40 'start chart top
Const L_START As Long = 40 'start chart left
Dim PPTApp As Object
Dim PPTPres As Object
Dim PPTShape As Object
Dim mySlide, myslide2 As Object, i As Long
Dim Chrt As ChartObject, T As Long, L As Long
If PPTApp Is Nothing Then _
Set PPTApp = CreateObject(class:="PowerPoint.Application")
PPTApp.Visible = True
Set PPTPres = PPTApp.Presentations.Add()
Set mySlide = PPTPres.Slides.Add(1, 1)
i = 0
For Each Chrt In ActiveSheet.ChartObjects
Chrt.Chart.CopyPicture
i = i + 1
'work out the top/left values
T = T_START + (Application.Floor((i - 1) / PER_ROW, 1)) * Chrt.Height
L = L_START + ((i - 1) Mod PER_ROW) * Chrt.Width
With mySlide.Shapes
.Paste
.Item(.Count).Top = T
.Item(.Count).Left = L
End With
Next Chrt
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.