VBA: Print graphs from Excel to PowerPoint help ;/

[bergsorensen]

Hello Mr. Excel

Long term passive member, first post

I have a small VBA job i need coded (forgive my code-lacking skills, just recently started using VBA.. couple of days ago), stuck on the syntax.

What im trying todo is:
- From a list (array) pick each graph with the corrosponding name, and copy that graph (as a meta-picture) to a new slide in an PowerPoint Pres..
- I can create a new empty powerpoint object, but im having trouble with the "looping-through-each-graph-and-copy-to-new-slide" part.

Again, im not familiar with the VBA syntax, communicating with Powerpoint from excel.

Here is my humble code so far:

-------------------------------------------------------------------

'Options
Option Base 1


'Macro
Sub CopyChartsToPPT()


'Declare variables
'Excel
Dim arrGraphs() As String
Dim Graphtobeprinted As String
'PowerPoint
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSld As PowerPoint.slide




'Array of graphs to be copied
i = 1 'start position
While ActiveWorkbook.Sheets("Controls").Cells(i, 1) <> vbNullString
x = x + 1
ReDim Preserve arrGraphs(x)
arrGraphs(x) = ActiveWorkbook.Sheets("Controls").Cells(i, 1)
i = i + 1
Wend

'Create powerpoint presentation object
Set pptApp = CreateObject("PowerPoint.Application")
Set pptPres = pptApp.Presentations.Add
Set pptPres = pptApp.ActivePresentation
pptApp.ActiveWindow.ViewType = ppViewSlide

'Loop
For x = LBound(arrGraphs) To UBound(arrGraphs)
Graphtobeprinted = arrGraphs(x)
'Create new powerpoint dias 'HELP NEEDED FOR THIS SECTION
Set pptSld = pptPres.Slides.Add(x + 1, 12)

'Copy graph
'...
'Paste graph
'...
'Make center/size stuff.. "make it look pretty"
'...
Next

MsgBox ("Done Total of " & i - 1 & " graphs were copied to PowerPoint")

End Sub




Best
Kasper

 

[bergsorensen]

Update: code now creates the ppt, and the dias, but im still unsure how to do the copy-chart loop:

'Options
Option Base 1


'Macro
Sub CopyChartsToPPT()


'Declare variables
'Excel
Dim arrGraphs() As String
Dim Graphtobeprinted As String
'PowerPoint
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSld As PowerPoint.slide




'Array of graphs to be copied
i = 1 'start position
While ActiveWorkbook.Sheets("Controls").Cells(i, 1) <> vbNullString
x = x + 1
ReDim Preserve arrGraphs(x)
arrGraphs(x) = ActiveWorkbook.Sheets("Controls").Cells(i, 1)
i = i + 1
Wend

'Create powerpoint presentation object
Set pptApp = CreateObject("PowerPoint.Application")
Set pptPres = pptApp.Presentations.Add
Set pptPres = pptApp.ActivePresentation
pptApp.ActiveWindow.ViewType = ppViewSlide

'Loop
For x = LBound(arrGraphs) To UBound(arrGraphs)
Graphtobeprinted = arrGraphs(x)

'Create new powerpoint dias
Set pptSld = pptPres.Slides.Add(x, ppLayoutTitleOnly)

'Copy chart as a picture
'Graphs.ChartObjects(x).CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
Format:=xlPicture

'Paste chart
'PPSlide.Shapes.Paste.Select


Next

MsgBox ("Done Total of " & i - 1 & " graphs were copied to PowerPoint")

End Sub

 

[bergsorensen]

Another update. Works! Sort of.. C/P the graphs to the powerpoint, though the excel "sheet" name is hardcoded, need to work that into the array.

Also, and more important, how do you resive the metafile which is inserted into the powerpoint? (resize to the screen aswell as center).

Current code:

'Options
Option Base 1


'Macro
Sub CopyChartsToPPT()


'Declare variables
'Excel
Dim arrGraphs() As String
Dim Graphtobeprinted As String
'PowerPoint
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSld As PowerPoint.slide




'Array of graphs to be copied
i = 2 'start position
While ActiveWorkbook.Sheets("Controls").Cells(i, 1) <> vbNullString
x = x + 1
ReDim Preserve arrGraphs(x)
arrGraphs(x) = ActiveWorkbook.Sheets("Controls").Cells(i, 1)
i = i + 1
Wend

'Create powerpoint presentation object
Set pptApp = CreateObject("PowerPoint.Application")
Set pptPres = pptApp.Presentations.Add
Set pptPres = pptApp.ActivePresentation
pptApp.ActiveWindow.ViewType = ppViewSlide

'Loop
For x = LBound(arrGraphs) To UBound(arrGraphs)
Graphtobeprinted = arrGraphs(x)

'Create new powerpoint dias
Set pptSld = pptPres.Slides.Add(x, ppLayoutTitleOnly)

'Copy chart as a picture
Sheets("Graphs").Select
ActiveSheet.ChartObjects(Graphtobeprinted).Activate
ActiveChart.ChartArea.Copy


'Paste chart
pptSld.Application.Activate
pptSld.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile


Next

MsgBox ("Done Total of " & i - 2 & " graphs were copied to PowerPoint")

End Sub