Ok, so I have 16 references in a dropdown list, located at C10 on my spreadsheet, this alters the information in the ranges A1:Q39, after which I want range A1:Q39 and range A41:Q69 to be copied as pictures to individual slides on a powerpoint presentation.
Sub ExcelRangeToPowerPoint()
Dim rng As Range
Dim rng2 As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Set rng = ThisWorkbook.ActiveSheet.Range("A1:Q39")
Set rng2 = ThisWorkbook.ActiveSheet.Range("A41:Q69")
On Error Resume Next
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
Err.Clear
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
On Error GoTo 0
Application.ScreenUpdating = False
Set myPresentation = PowerPointApp.Presentations.Add
Set mySlide = myPresentation.Slides.Add(1, 12)
Cells(10, 3) = "2018A"
rng.Copy
mySlide.Shapes.PasteSpecial DataType:=3
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
myShape.Left = 56
myShape.Top = 52
PowerPointApp.Visible = True
PowerPointApp.Activate
Application.CutCopyMode = False
Set mySlide = myPresentation.Slides.Add(1, 12)
rng2.Copy
mySlide.Shapes.PasteSpecial DataType:=3
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
myShape.Left = 56
myShape.Top = 100
PowerPointApp.Visible = True
PowerPointApp.Activate
Application.CutCopyMode = False
This is what I have so far, this just gets repeated 16 times for the reference that's being altered by Cells(10, 3).
When I try to run the macro, it might work for a few of those references but I usually get a runtime error "shapes.pastespecial : Invalid request. The specified data type is unavailable" I'm, as you can tell, quite inexperienced when it comes to VBA, but I'm hoping someone might be able to shed some light on this for me? If you need any more information, please let me know. Thanks.
Related
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
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.
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
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)
I'm writing some code to automatically copy some of the charts from an excel to a ppt. The first issue that I am facing is with the variable declaration
Dim newPowerPoint As PowerPoint.Application
Dim activeSlide As PowerPoint.Slide
The error is "User defined-type not defined". Just to let you know I'm pretty new to this VBA, so some descriptive comments would be really helpful.
the error you are getting is because your powerpoint variables want to be defined as objects, and the objects set to be powerpoint applications later on.
Sub ChartX2P()
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
If ActiveChart Is Nothing Then
MsgBox "Hey, please select a chart first."
Exit Sub
End If
If PowerPointApp Is Nothing Then _
Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
On Error GoTo 0
Application.ScreenUpdating = False
'this will create a new powerpoint for your chart
Set myPresentation = PowerPointApp.Presentations.Add
'this will open an old powerpoint up, just change "File address" to the address
'Set myPresentation = PowerPointApp.Presentations.Open(Filename:="FileAddress")
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
ActiveChart.ChartArea.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
End Sub
This is taken from here, but it looks pretty straightforward, anything you can't get from the site let me know