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

onthegreen03

Board Regular
Joined
Jun 30, 2016
Messages
148
Office Version
  1. 365
Platform
  1. Windows
Hi -

I have some code that I copied from other users on line which opens PP (Procedure1) and then copies and pastes ranges from Excel (Procedure2) into that PP. When I run the code below it opens the Powerpoint no problem but it breaks down in Procedure2. Can someone help me figure out what needs to be fixed in Procedure 2 so that it copies/pastes the selected range into the PP opened in Procedure1? The code breaks at the "Add a slide to the presentation" step. Hopefully this makes sense. Many thanks for your help!

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

Sub RunAllMacros()
Procedure1
Procedure2
End Sub

Sub Procedure1()

Dim objPPT As Object

Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True

objPPT.Presentations.Open "C:\users\migreen\AppData\Roaming\Microsoft\Templates\Blank.potx"

End Sub

Sub Procedure2()

Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object

'Copy Range from Excel
Set rng = ThisWorkbook.ActiveSheet.Range("A1:C12")

'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly

'Copy Excel Range
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 = 66
myShape.Top = 152

'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate

'Clear The Clipboard
Application.CutCopyMode = False

End Sub
 
Please test this:

Code:
Sub CreatePowerPoint()
'Add a reference to the Microsoft PowerPoint Library by:
'1. Go to Tools in the VBE menu
'2. Click on Reference
'3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay
'First we declare the variables we will be using
Dim newPowerPoint As PowerPoint.Application, activeSlide As PowerPoint.Slide
Dim cht As Excel.ChartObject, pres As Presentation
'Look for existing instance
On Error Resume Next
Set newPowerPoint = CreateObject("PowerPoint.Application")
newPowerPoint.Visible = True
newPowerPoint.Presentations.Open "c:\pub\template2.potx"
On Error GoTo 0
Set pres = newPowerPoint.ActivePresentation
Do While pres.Slides.Count > 1
    pres.Slides(pres.Slides.Count).Delete
Loop
'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
For Each cht In ActiveSheet.ChartObjects
    'Add a new slide where we will paste the chart
    pres.Slides.Add pres.Slides.Count + 1, ppLayoutText
    newPowerPoint.ActiveWindow.View.GotoSlide pres.Slides.Count
    Set activeSlide = pres.Slides(pres.Slides.Count)
    'Copy the chart and paste it into the PowerPoint as a Metafile Picture
    cht.Select
    ActiveChart.ChartArea.Copy
    activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
    'Set the title of the slide the same as the title of the chart
    activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
    'Adjust the positioning of the Chart on Powerpoint Slide
    newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15
    newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125
    activeSlide.Shapes(2).Width = 200
    activeSlide.Shapes(2).Left = 505
    'If the chart is the "Revlimid" consumption chart, then enter the appropriate comments
    If InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text, "Revlimid") Then
        activeSlide.Shapes(2).TextFrame.TextRange.Text = Range("J7").Value & vbNewLine
        activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J8").Value & vbNewLine)
        activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J9").Value & vbNewLine)
        activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J10").Value & vbNewLine)
    'Else if the chart is the "Pomalyst" consumption chart, then enter the appropriate comments
    ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text, "Pomalyst") Then
        activeSlide.Shapes(2).TextFrame.TextRange.Text = Range("J27").Value & vbNewLine
        activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J28").Value & vbNewLine)
        activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J29").Value & vbNewLine)
        activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J30").Value & vbNewLine)
    End If
    activeSlide.Shapes(2).TextFrame.TextRange.Font.Size = 16    ' callout box
Next
pres.Slides(1).Delete
AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing: Set newPowerPoint = Nothing
pres.SaveAs "c:\pub\finaldeck.pptx"
MsgBox "End of code!", vbInformation
End Sub
 
Upvote 0

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Hi Worf - Works like a charm! I really want to thank you again for all of your help on these various VBA codes. If you don't mind the challenge (both big and small) I will reply to this post if I run into a more problems. There are a few more things I am working on that may require some professional intervention! Thanks again!!!
 
Upvote 0
Hi Worf - Question about an VBA error I get when I try to run that copy/paste from Excel to PP (single range). I copied the code from one Excel file to another one and changed the range I am trying to copy. When I run the macro I get an error message (Reads "Compile Error: User-Defined type not defined".) The code stops at Procedure 2 and the code that reads "mypres As PowerPoint.Presentation" is highlighted. I tried the code in the original Excel file and it runs all the way through with no problems, but when I copy the code to another file and try to run the code it does not work. Can you please disagnois and help me find the error in my ways? Code below in case you need it.

Sub CopyE2PP()
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

'Copy Excel Range
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
 
Upvote 0
Hi

On the new file, set a reference at VBE>Tools>References>Microsoft PowerPoint Object Library.
 
Upvote 0
Hi Worf -

I did as you instucted and tried running the code again in that new Excel template. When I run the code now it opens up an instance of PP (all good so far) but it stops at the line "Set mypres = objppt,.ActivePresentation" and that line is highlighted in yellow. If it wasn't clear from my last post I am trying to make these marcos "portable" so I can simply copy them from one Excel file to another and change the range that I want to copy. I'd like to make the multiple range macro portable as well ... once we solve this issue I will likely need to apply the same fix to the other macro you worked on for me that copies multiple ranges.

Let me know what you think ... you said you like challenges!

Thanks!
 
Upvote 0
Hi

1) The code below worked for me. What error number and message are you getting?
2) Concerning portability, we can choose between early and late binding. See this page: Early vs. Late Binding

Code:
' Excel module
Dim objppt As PowerPoint.Application


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


Sub Procedure1()
Set objppt = CreateObject("PowerPoint.Application")
objppt.Visible = True
objppt.Presentations.Open "c:\pub\template2.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
 
Upvote 0
Hi Worf - I'm glad I logged in .... I never received email notification that you responded to my last post. I thought you gave up on me! Let me try pasting in the code you sent that worked for you and I'll let you know what error message I get. Hopefully it will work. It's weird. The code runs beautifully when I run it in the original file that you helped me with back in July. But when I try to copy the code to a new Excel template and run the code it does not work. Let me try again now and I'll get back to you today or tomorrow. Thanks again for sticking around with this. Would love to discuss the early and late binding with you .... maybe you can tell me which one would work better based on how I plan to use the coding.
 
Upvote 0
Hi Worf - It worked! I'm not sure what I was doing wrong the first couple of times I tried it but it appears to be fine now. I opened a new Excel spreadsheet, set the reference to PP, and pasted in the code. It ran all the way through. Can you explain early vs. late binding? Upon reading the link you sent it appears the code I have is using early binding. If I understood the article correctly if I used late binding I would not have to worry about setting the reference to PP. Is that the key difference?
 
Upvote 0

Forum statistics

Threads
1,214,388
Messages
6,119,229
Members
448,879
Latest member
VanGirl

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top