Excel VBA - copying of excel charts in to PPT (Excel 2016)

[dombek100]

Hi everyone, I am looking for help with my macro that I wrote recently.
Its fairly simple, though I still have some problems with it to work correctly.
It should copy charts (to be precise define rages found by their name) from excel file and paste them to PPT presentation first creating new slide, and then pasting the chart.
It seems I have problem with the loop and with pasting the chart… It always goes to the last slide.
Another question would be how to paste for example 4 charts on one slide? and place them as I want.



Sub Export_PPT_E()
Dim ppApp As Object
Dim Name As Name
Dim powerpointApp As Object
Dim Slidecount As Long
Dim PPSlide As PowerPoint.Slide
Dim ChartName As String
Dim x As Integer
WB_Name = ActiveWorkbook.Name
WS_Name = ActiveSheet.Name
Application.Calculation = xlCalculationAutomatic
Set powerpointApp = CreateObject("Powerpoint.Application")
With powerpointApp
.Visible = True
.Presentations.Open Filename:="C:\Users\xxx\xxxx.pptx"
End With
x = 1

''-----------------------------------------------------------------------------------

Select Case x
Case 1
ChartName = "Chart1"
Case 2
ChartName = "Chart2"
Case 3
ChartName = "Chart3"
Case 4
ChartName = "Chart4"
Case 5
ChartName = "Chart5"
Case 6
ChartName = "Chart6"
Case 7
ChartName = "Chart7"
Case 8
ChartName = "Chart8"
Case 9
ChartName = "Chart9"
Case 10
ChartName = "Chart10"
Case 11
ChartName = "Chart11"
End Select

Do Until x = 11

'ChartName = ActiveWorkbook.Names("Chart1").Name
Application.Goto Reference:=ActiveWorkbook.Names(ChartName).Name
With Workbooks(WB_Name).Worksheets(WS_Name)
.Range(ChartName).Select
.Range(ChartName).Copy
End With

With powerpointApp
.Visible = True
Slidecount = powerpointApp.ActivePresentation.Slides.Count
If x > 1 Then Set PPSlide = powerpointApp.ActivePresentation.Slides.Add(Slidecount, ppLayoutBlank)
If Slidecount = 1 Then .ActivePresentation.Slides(.ActivePresentation.Slides().Count).Select Else .ActivePresentation.Slides(.ActivePresentation.Slides().Count - 1).Select
End With

With powerpointApp.ActiveWindow 'ActivePresentation.Slides(x)

.View.PasteSpecial DataType:=ppPasteEnhancedMetafile 'ppPasteOLEObject 'DataType:=ppPasteJPG
.Selection.ShapeRange.Left = 70.6
.Selection.ShapeRange.Top = 65.45
.Selection.ShapeRange.Width = 450
.Selection.ShapeRange.Height = 430
End With

x = x + 1
Loop
End Sub

[werafa]

some ideas,

set your chosen slide as an object - you can then examine it before you paste your chart into it
What does slidecount say? ie, which if/then option is chosen? (you might change this to a select case for clarity - but this is probably cosmetic)

let me know if this does not shake something loose as I do have an application where I have done this, and will dig it up if required.

Werafa

[werafa]

ps,

Kudos for attempting VBA in ppt

[dombek100]

some ideas,

set your chosen slide as an object - you can then examine it before you paste your chart into it
What does slidecount say? ie, which if/then option is chosen? (you might change this to a select case for clarity - but this is probably cosmetic)

let me know if this does not shake something loose as I do have an application where I have done this, and will dig it up if required.

Werafa

Hi thx for reply. I made this macro so that it works though I know it’s not optimal.
I had some problems and needed to use some workarounds. Biggest issue was that the code didn’t see user defined ranges – those defined in name manager.
Second is that when copying from Excel to Power Point the latter often lost “focus” resulting in error with no metafile to paste…
Last thing that bothers me is that in order to copy the ranges I select the worksheet. Could it be done without selecting (so that I could for example hide the sheet in the file I am copying ranges from?)

Below is part of my code:


ActiveWorkbook.Worksheets("Export").Select 'this is the part I would like to change - no select
For p = 1 To lastSlide 'this is the number of slides there will be in Power Point presentation.
Select Case p
Case 1
Set r = Range("Slide1") 'r is a range variable Slide1 is my defined range that I will copy from Excel
Case 2
Set r = Range("Slide2")
… 'and so on
Case 11
Set r = Range("Slide11")
End Select


With ActiveWorkbook.Worksheet("Export")
r.Select
r.Copy
End With


I declared variable ws = ActiveWorkbook .Worksheet(“Export”)

And wrote in Select Case:
Set r = ws.Range(“Slide1”)
But later an error occurred when trying to:
r.Select

Do you have any ideas how to solve it?

[dombek100]

some ideas,

let me know if this does not shake something loose as I do have an application where I have done this, and will dig it up if required.

Werafa

If its not a problem, It would be helpful. Mabye I could use some of your ideas.

[werafa]

Hi Dombek,

first,, once you have defined a range, you do not need to 'select' it in order to work with it.
you can rem out 'r.select' and the code should work the same as it does now

I'd suggest that you do also use 'readable' variable names. I typically use 'myRange' if working with one range only, or 'rInput', 'rOutput' etc for more descriptive code. Strings might be 'sName' and long integer might be 'lRow'. this doesn't help you with your question, but developing good coding techniques will definitely help you as your code becomes more complex.

From the look of it, you do not need to use Case to get your range name. If p = 11, and the range name = 'Slide11", you can

sSlideName = "Slide" & p

Your code can then be simplified to:

sSheetName = "The Name of the relevant worksheet"
set r = thisworkbook.worksheets(sSheetName).range(sSlideName)

You will notice thisworkbook here - this is usually assumed by excel, but I find that explicit definition helps readability when working with multiple workbooks etc.

re the 'why r.select didn't work' - it should have - assuming that there are no bugs in your code. Do you have the 'Locals' window open? I find this so useful that I have it permanently open in the VBE, and define objects frequently so that I can track them in this window. My first question is, is 'r' = nothing? this is one good reason you can not select it - and would mean that the 'set r =' has failed. Use the locals window to check this.


Let me know how you go
Werafa