Macro to open Powerpoint and paste ranges from Excel - Troubleshoot error in code

Some videos you may like

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

onthegreen03

Board Regular
Joined
Jun 30, 2016
Messages
61
Thanks again Worf for all of your help. I hope you don't mind that I drop you a post every now and again as I continue to venture into unchartered (for me) VBA territory. Be well.
 

onthegreen03

Board Regular
Joined
Jun 30, 2016
Messages
61
Hi Worf - Me again from sunny New Jersey, USA. I'm still having a problem with that Excel to PP code. When I run the code it opens PP but stops at the following line in red below.

Sub Copy6in2016()
Procedure1
Procedure2
MsgBox "Success!", 64
End Sub

Sub Procedure1()
Set objppt = CreateObject("PowerPoint.Application")
objppt.Visible = True
objppt.Presentations.Open "M:\Forecasting\Models\2016\Data Summary\E2P\Blank.potx"
End Sub

Sub Procedure2()
Dim rng As Range, mypres As PowerPoint.Presentation, mySlide As Object, myShape As Object
Set rng = ThisWorkbook.ActiveSheet.[B1:N30]
Set mypres = objppt.ActivePresentation
Set mySlide = objppt.ActiveWindow.View.Slide
rng.Copy
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShape.Left = 8
myShape.Top = 100
myShape.Width = 700
myShape.Height = 400
End Sub

Some issue I had before. It works when I run it in the original file but when I copy the code and try running it in another file it does not work. I'd really like to get this thing working consistently. Any help or advice you can give me would be appreciated. Thanks in advance!
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,004
Try this new version:

Code:
' Excel module
Sub Copy6in2016()
Dim rng As Range, mypres As PowerPoint.Presentation, mySlide As Object, _
myShape As Object, objppt As PowerPoint.Application
Set objppt = CreateObject("PowerPoint.Application")
objppt.Visible = True
objppt.Presentations.Open "c:\pub\template2.potx"       ' your path here
Set rng = ThisWorkbook.ActiveSheet.[B1:N30]
Set mypres = objppt.ActivePresentation
Set mySlide = objppt.ActiveWindow.View.Slide
rng.Copy
mySlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
myShape.Left = 8        ' set position
myShape.Top = 100
myShape.Width = 700
myShape.Height = 400
MsgBox "Success!", 64
End Sub
 

onthegreen03

Board Regular
Joined
Jun 30, 2016
Messages
61
Worked like a charm! Awesome stuff Worf. I may have another challenge for you regarding sizing my Excel objects in PP once I paste them as pics. Let me troubleshoot and I'll send you another post in a day or two. As always thanks for the help!
 

onthegreen03

Board Regular
Joined
Jun 30, 2016
Messages
61
Hi Worf - I have a question on a different topic. I created a waterfall chart in Excel and one of the values is a negative number. But when I add data labels the number in the label does not show the negative sign so it appears as a positive number even though the corresponding bar is going down. I've tried going into formatting to change the number format to Currency so I can then select the negative value there but it won't let me select it as an option. How can I can format the data label to show the negative number when in fact the number is negative? Let me know if you need more information or would like to see the actual file. Thanks as always.
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,004
Hi

· What Excel version are you using? Did you create the chart with Excel built-in capabilities or using an add-in? Microsoft only with Office 2016 introduced waterfall charts.
· Working with the actual file is always better, if you can provide a link to it.
· When the topic at hand is different from the thread originator, it is preferable to start a new thread.
· Let us see if this can be sorted out without code…
 

onthegreen03

Board Regular
Joined
Jun 30, 2016
Messages
61
Hi Worf -

I am using Excel 2016 but the waterfall was manually built. You know what, let's drop this issue and stay with the original thread as you suggest. I didn't mean to deviate ... it was just frustrating me that I could not figure it out. I will keep trying ... a workaround is inserting a text box and linking it to the negative number rather than using the data label.

Okay, you said you like challenges so here is one. I am almost done with the Excel to PP code. I have it built where I am copying multiple ranges from different tabs and pasting into PP and it works beautifully. I have 2 hurdles I'd like to clear:

1. Do you know how to add titles to each of the generated slides? What I'd like is that for every slide added I can add a unique slide title to each. Ideally each slide would have a title and subtitle. See the link below that I found on the Microsoft site. It seems there is a way to add slide titles but the code it way beyond my capabilities.

https://support.microsoft.com/en-us/kb/162612

2. In the current code there is the ability to move the pictures left and down from the top using the myshape.left and myshape.top lines of code. Is it possible to change these setting to an array so I can adjust each slide individually (similar to how I can adjust the width and height of the picture)?

Current code is below:

Dim objppt As PowerPoint.Application
Sub RunAllMacros()
Procedure1
Procedure2
MsgBox "Success!", 64
End Sub

Sub Procedure1()
Set objppt = CreateObject("PowerPoint.Application")
objppt.Visible = True
objppt.Presentations.Open "M:\Forecasting\Models\2016\Data Summary\E2P\Blank.potx" ' your path here
End Sub

Sub Procedure2()
Dim rng As Range, mypres As PowerPoint.Presentation, mySlide As Object, _
myShape As Object, sar, i%, rad, wa, ha
sar = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6")
rad = Array("B7:T33", "B7:K33", "B3:P39", "B3:P39", "B3:P39", "B2:P36") ' ranges
wa = Array(0.8, 0.8, 0.9, 0.9, 0.9, 0.9) ' percentages of slide width and height
ha = Array(0.8, 0.8, 0.8, 0.8, 0.8, 0.8)
Set mypres = objppt.ActivePresentation
Do While mypres.Slides.Count > 1
mypres.Slides(mypres.Slides.Count).Delete
Loop
Set mySlide = objppt.ActiveWindow.View.Slide
For i = LBound(sar) To UBound(sar)
Set rng = ThisWorkbook.Sheets(sar(i)).Range(rad(i))
rng.Copy
mySlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
myShape.LockAspectRatio = 0
myShape.Left = 40
myShape.Top = 80
myShape.Width = wa(i) * mypres.PageSetup.SlideWidth ' set picture size
myShape.Height = ha(i) * mypres.PageSetup.SlideHeight
Set mySlide = mypres.Slides.Add(mypres.Slides.Count + 1, 11)
Next
If mypres.Slides.Count > 3 Then mypres.Slides(mypres.Slides.Count).Delete
objppt.Visible = 1
objppt.Activate
Application.CutCopyMode = False ' clear clipboard
mypres.SaveAs "c:\pub\finaldeck.pptx"
End Sub

Thanks!!
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,004
I don’t like unanswered topics, so:

-The picture below shows two charts, the one above is a true waterfall, and both displayed the negative sign automatically.
-Another way to insert information into data labels is the value from cells option, also shown.
-I’ll be back later with the PowerPoint stuff.

 
Last edited:

onthegreen03

Board Regular
Joined
Jun 30, 2016
Messages
61
Next time you are in the Stares I owe you a drink! I'll wait to hear from you on the PP questions. That automation is cool stuff. As always give me the word when you get sick of me.
 

Watch MrExcel Video

Forum statistics

Threads
1,102,448
Messages
5,486,958
Members
407,574
Latest member
Greso

This Week's Hot Topics

Top