VBA Copy range from excel to powerpoint - excel

I am trying to copy a specific range from excel and past it in pp as a picture. I have pieced together the following code from various online sources and continue to get a run time 91 error ( Object Variable or With block variable not set) when running PowerPointApp.WindowState = 2.
How can I fix this error, and avoid it in future?
first i successfully run
Private Sub OpenPowerpoint()
Dim PPT As PowerPoint.Application
Set PPT = New PowerPoint.Application
PPT.Visible = True
PPT.Presentations.Open Filename:="C:\Users\aofarrell\Desktop\CYB\Weekly Pack Update - Template.pptx"
PPT.ActivePresentation.Slides(2).Select
End Sub
Then I attempt to run
Private Sub CopyToPowerPoint()
Dim rng As Range
Dim PowerPointApp As Object
Dim mySlide As Object
Dim myShape As Object
'Copy Range from Excel
Set rng = ThisWorkbook.Sheets("Triggers").Range("B6:Z33")
'Copy Excel Range
rng.Copy
'Paste to PowerPoint and position
PowerPointApp.WindowState = 2 'ERROR OCCURS HERE
mySlide.Shapes.PasteSpecial DataType:=0
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShape.Left = 20
myShape.Top = 70
myShape.Width = 675
myShape.Height = 400
'Clear The Clipboard
Application.CutCopyMode = False
Application.Wait (Now + TimeValue("00:00:01"))
End Sub

Hmm... Well, first you need to define what type of Object your PowerPointApp is. And what specific object your mySlide is. Remember also that Local variables are destroyed at the end of the Sub/Function, so you may want some Module level variables/objects instead:
Option Explicit
Private PPT As PowerPoint.Application
Private PPT_pres As PowerPoint.Presentation
Private Sub OpenPowerpoint()
Set PPT = New PowerPoint.Application
PPT.Visible = True
Set PPT_pres = PPT.Presentations.Open(FileName:="C:\Users\aofarrell\Desktop\CYB\Weekly Pack Update - Template.pptx")
PPT_pres.Slides(2).Select
End Sub
Private Sub CopyToPowerPoint()
If PPT Is Nothing Then Exit Sub
If PPT_pres Is Nothing Then Exit Sub
Dim rng As Range
Dim mySlide As Object
Dim myShape As Object
Set mySlide = PPT_pres.Slides(2)
'Copy Range from Excel
Set rng = ThisWorkbook.Sheets("Triggers").Range("B6:Z33")
'Copy Excel Range
rng.Copy
'Paste to PowerPoint and position
PPT.WindowState = 2
mySlide.Shapes.PasteSpecial DataType:=0
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShape.Left = 20
myShape.Top = 70
myShape.Width = 675
myShape.Height = 400
'Clear The Clipboard
Application.CutCopyMode = False
Application.Wait (Now + TimeValue("00:00:01"))
End Sub
(Also: if I was copying as an Image from Excel to PowerPoint, I would usually use Range.CopyPicture xlPrinter rather than Shapes.PasteSpecial which changes the size of the image based on your screen resolution)

Related

Write a VBA Code to Export dynamic range and Paste to Powerpoint

I am hoping I could get some assistance with this code. I found the below code from The Spreadsheet Guru to copy a range of cells and paste them on different slides in PowerPoint. Problem is - the range (a puzzle) changes based on the values of cell "A6"enter image description here.
I want to export the puzzle, which is Range("M1:U11"), but I want each puzzle from No 1 to 300 to appear on its own separate slide on the Powerpoint Presentation. So When A6 = 1, puzzle no 1 is exported, when A = 2, puzzle no 2 is exported, and so on and so forth.
Private Sub CommandButton1_Click()
'Declare our Variables
Dim r As Range
Dim powerpointapp As Object
Dim mypresentation As Object
Dim myslide As Object
Dim myshape As Object
'assigning range into variable
Set r = ThisWorkbook.Worksheets("Sheet1").Range("M1:U11")
'If we have already opened powerpoint
Set powerpointapp = GetObject(class:="PowerPoint.Application")
'If powerpoint is not opened
If powerpointapp Is Nothing Then Set powerpointapp = CreateObject(class:="PowerPoint.Application")
'To create a new presentation
Set mypresentation = powerpointapp.Presentations.Add
'I tried creating a For Loop through all the values in "A6" but got stuck
Set myslide = mypresentation.slides.Add(1, 11)
r.Copy
'to paste range
myslide.Shapes.PasteSpecial DataType:=2
Set myshape = myslide.Shapes(myslide.Shapes.Count)
myshape.Left = 250
myshape.Top = 150
powerpointapp.Visible = True
powerpointapp.Activate
'to clear the cutcopymode from clipboard
Application.CutCopyMode = False
'Keep going if there is an error
On Error Resume Next
End Sub

For...Next fail with Worksheets(i).ChartObjects. Any suggestions?

Sub ChartExporter()
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim i As Integer
If PowerPointApp Is Nothing Then _
Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
On Error GoTo 0
Application.ScreenUpdating = False
Set myPresentation = PowerPointApp.Presentations.Add
For i = 1 To ThisWorkbook.Worksheets.Count
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
Worksheets(i).ChartObjects.Select 'THIS IS HIGHLIGHTED
Selection.Copy
mySlide.Shapes.Paste
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
myShape.Left = 200
myShape.Top = 200
PowerPointApp.Visible = True
PowerPointApp.Activate
Application.CutCopyMode = False
Next
End Sub
VBA debugger points to the line containing Worksheets(i).Chartobjects.Select is highlighted. However, activesheet does seem to work.
My logic is that if i=1 then select chart objects, and copy those into the newly inserted slide, and then insert new slide again with worksheet(2) and so on...
Basically, I am trying to copy and paste every chart from every worksheet into every new slide.

How to open existing powerpoint and paste an excel range

I want to create a macro which opens an existing powerpoint template for me, copy data from a certain sheet of excel and then paste it in a specific slide in powerpoint.
I tried googling it online and created something but it doesnt work. The macro runs but I do not see any output. Please help. Below is the code I am working on:
Sub Excelrangetopowerpoint()
Dim rng As Range
Dim Powerpointapp As PowerPoint.Application
Dim myPresentation As PowerPoint.Application
Dim DestinationPPT As String
Dim myShape As Object
Dim myslide As Object
Set rng = Worksheets("regions").Range("B1:N18")
On Error Resume Next
Set Powerpointapp = CreateObject("Powerpoint.application")
DestinationPPT = ("C:\Users\OLX-Admin\Dropbox (Corporate Finance)\Naspers Monthly Reporting\Prep for call\From teams\FY2019\OLX Group Monthly Report_Sep'18_Macro.pptx")
Powerpointapp.Presentations.Open (DestinationPPT)
If Err.Number = 429 Then
MsgBox "Powerpoint could not be found.aborting."
Exit Sub
On Error GoTo 0
Application.ScreenUpdating = False
rng.Copy
Set myslide = PowerPoint.ActivePresentation.Slides(4)
myslide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = myslide.Shapes(myslide.Shapes.Count)
myShape.Left = 152
myShape.Top = 152
Powerpointapp.Visible = True
Powerpointapp.Activate
activation.CutCopyMode = False
End If
End Sub
This should work.
There were some missing parts of your modified code.
Notice that if the presentation is already open, this code will open the existing file in "read-only" mode... (so it doesn't care if powerpoint file is already opened or not).
VBA Code
Sub Excelrangetopowerpoint()
Dim rng As Range
Dim Powerpointapp As Object
Dim myPresentation As Object
Dim DestinationPPT As String
Dim myShape As Object
Dim mySlide As Object
'Copy Range from Excel
Set rng = Worksheets("regions").Range("B1:N18")
'Create an Instance of PowerPoint
On Error Resume Next
'Set your destination path for the powerpoint presentation and open the file
Set Powerpointapp = CreateObject("Powerpoint.application")
DestinationPPT = ("C:\Test\My Powerpoint\Presentation1.pptx")
Powerpointapp.Presentations.Open (DestinationPPT)
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "Powerpoint could not be found.aborting."
Exit Sub
End If
On Error GoTo 0
'Optimize Code
Application.ScreenUpdating = False
'Set my current Powerpoint window as activated
Set myPresentation = Powerpointapp.ActivePresentation
'Set which slide to paste into
Set mySlide = myPresentation.Slides(4)
'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 = 152
myShape.Top = 152
'Make PowerPoint Visible and Active
Powerpointapp.Visible = True
Powerpointapp.Activate
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
Source: The code is a combination of the work by Chris Newman: "Copy & Paste An Excel Range Into PowerPoint With VBA" & "Copy & Paste Multiple Excel Ranges To Separate PowerPoint Slides With VBA" but with the modification that you add a path to an already existing PowerPoint file.
you were getting that error because of the below line.
Set myslide = PowerPoint.ActivePresentation.Slides(4)
The correct code is
Set myslide = PowerPointapp.ActivePresentation.Slides(4)

Macro to copy paste multiple excel ranges in PPT

I have finally been able to create this macro, which copying data from a specific range in excel and pasting it into an existing PPT.
Now I want to repeat this action for multiple slides, but instead of copy pasting this macro, again and again, is there any shorter code where I just change the range, destination slide, positioning and it creates the complete set.
Here is the existing code which is working fine:
'Macro1
Sub excelrangetopowerpoint_month()
Dim rng As Range
Dim powerpointapp As Object
Dim mypresentation As Object
Dim destinationPPT As String
Dim myshape As Object
Dim myslide As Object
Set rng = Worksheets("objectives").Range("m1")
On Error Resume Next
Set powerpointapp = CreateObject("powerpoint.application")
destinationPPT = ("C:\Users\OLX-Admin\Dropbox (Corporate Finance)\Naspers Monthly Reporting\Prep for call\From teams\FY2019\OLX Group Monthly Report_Sep'18_Macro.pptx")
powerpointapp.Presentations.Open (destinationPPT)
On Error GoTo 0
Application.ScreenUpdating = False
Set mypresentation = powerpointapp.ActivePresentation
Set myslide = mypresentation.Slides(1)
rng.Copy
myslide.Shapes.PasteSpecial DataType:=2 '2 = enhanced metafile
Set myshape = myslide.Shapes(myslide.Shapes.Count)
myshape.Left = 278
myshape.Top = 175
powerpointapp.Visible = True
powerpointapp.Activate
Application.CutCopyMode = False
End Sub
You could do it with another procedure like below. So you only have to duplicate one line for every copy to a slide.
Also note that your error handling was silent. That's a bad idea, because if an error occurs you just ignore it and you will never notice. Also the following code would not work properly. I changed that too.
Sub excelrangetopowerpoint_month()
Dim powerpointapp As Object
Set powerpointapp = CreateObject("powerpoint.application")
Dim destinationPPT As String
destinationPPT = ("C:\Users\OLX-Admin\Dropbox (Corporate Finance)\Naspers Monthly Reporting\Prep for call\From teams\FY2019\OLX Group Monthly Report_Sep'18_Macro.pptx")
On Error GoTo ERR_PPOPEN
Dim mypresentation As Object
Set mypresentation = powerpointapp.Presentations.Open(destinationPPT)
On Error GoTo 0
Application.ScreenUpdating = False
PasteToSlide mypresentation.Slides(1), Worksheets("objectives").Range("m1")
'duplicate this line for all slides/ranges
'PasteToSlide mypresentation.Slides(2), Worksheets("objectives").Range("m2")
powerpointapp.Visible = True
powerpointapp.Activate
Application.CutCopyMode = False
ERR_PPOPEN:
Application.ScreenUpdating = True 'don't forget to turn it on!
If Err.Number <> 0 Then
MsgBox "Failed to open " & destinationPPT, vbCritical
End If
End Sub
Private Sub PasteToSlide(mySlide As Object, rng As Range)
rng.Copy
mySlide.Shapes.PasteSpecial DataType:=2 '2 = enhanced metafile
Dim myShape As Object
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
myShape.Left = 278
myShape.Top = 175
End Sub

copy from VBA excel to powerpoint

I am transferring data from excel to powerpoint slides with an automated script by using EXcel VBA. I'm trying to copy the usedrange of a excel worksheet and paste it to as a image in a powerpoint Template of 4th slide and from there on it should add new slides and copy the remaining worksheets to the next further slides.
The code which i'm currently using is getting the following error "öbject variable or with block variable not set"
Can anyone suggest me the code for the following.
Hope this is clearly explained. If not please ask for more clarification.
Thanks
Private Sub CommandButton2_Click()
Dim PP As PowerPoint.Application
Dim PPpres As PowerPoint.Presentation
Dim PPslide As Object
Dim PpShape As PowerPoint.Shape
Dim SlideTitle As String
Dim SlideNum As Integer
Dim WSrow As Long
Dim Sh As Shape
Dim Rng As Range
Dim myshape As Object
'Open PowerPoint and create new presentation
Set PP = GetObject(class, "PowerPoint.Application")
PP.Visible = True
PP.Presentations.Open FileName:=("\\C:\Users\Templates)"
'Specify the chart to copy and copy it
For Each WS In Worksheets
If (WS.Name) <> "EOS" Then
ThisWorkbook.Worksheets(WS.Name).Activate
ThisWorkbook.ActiveSheet.UsedRange.CopyPicture
'pSlide.Shapes.Paste
'Copy Range from Excel
Set Rng = ThisWorkbook.ActiveSheet.Range("A1:I8")
'Copy Excel Range
Rng.Copy
'Set PPslide = PPpres.Slides.Add(5, 33)
PP.ActiveWindow.View.GotoSlide (4)
Set PPslide = PPpres.Slides(4).Shapes.Paste
'Paste to PowerPoint and position
PPslide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myshape = PPslide.Shapes(PPslide.Shapes.Count)
'Set position:
myshape.Left = 66
myshape.Top = 152
End If
Next
'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate
'Clear The Clipboard
Application.CutCopyMode = Falseenter code here`
End Sub
Try changing:
'Set PPslide = PPpres.Slides.Add(5, 33)
PP.ActiveWindow.View.GotoSlide (4)
Set PPslide = PPpres.Slides(4).Shapes.Paste '<< CHANGING THIS LINE ONLY
'Paste to PowerPoint and position
PPslide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
To:
'Set PPslide = PPpres.Slides.Add(5, 33)
PP.ActiveWindow.View.GotoSlide (4)
Set PPslide = PPpres.Slides(4)
'Paste to PowerPoint and position
PPslide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Also, as per my comment, you'll need to change the following last few lines of your code:
'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate
'Clear The Clipboard
Application.CutCopyMode = Falseenter code here`
End Sub
To:
'Make PowerPoint Visible and Active
PP.Visible = True
PP.Activate
'Clear The Clipboard
Application.CutCopyMode = False
'enter code here
End Sub

Resources