I've been building a tool to generate PowerPoint slides from data in an excel workbook. I move back and forth between a computer at work and my computer at home. The work computer has Excel 2013 while the home computer has 2016. This generally isn't an issue...when I move from the home computer to the work computer I just have to change the reference from the v16 object library to the v15 object library.
Earlier this week though I ran into an error I couldn't resolve...detailed here One of the suggestions to resolve it was to switch to late binding so I didn't need the reference. That was a pretty easy switch, but it has led to an error in the resulting ppt slide...
In the original (early binding) version I set things up like
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PPLayout As CustomLayout
Dim PPshape As Variant
Dim tBox As PowerPoint.Shape
And then
Set PPApp = New PowerPoint.Application
Set PPPres = PPApp.Presentations.Open(fileName, msoTrue, , msoFalse)
And then part of the slide was built with
wsGenerator.Activate
wsGenerator.Range("B32:L37").Select
Selection.Copy
With PPSlide.Shapes.PasteSpecial(ppPasteMetafilePicture)
.Top = 450
.Left = 50
.Height = 100
.Width = 325
End With
Part of the resulting slide looks like this
The table at the bottom is the part pasted by the above code.
When I change to late binding, I simply make these changes
'Dim PPApp As PowerPoint.Application
Dim PPApp As Object
'Dim PPPres As PowerPoint.Presentation
Dim PPPres As Object
'Dim PPSlide As PowerPoint.Slide
Dim PPSlide As Object
'Dim PPLayout As CustomLayout
Dim PPLayout As Object
'Dim tBox As PowerPoint.Shape
Dim tBox As Object
Dim PPshape As Variant
And then
'Set PPApp = New PowerPoint.Application
Set PPApp = CreateObject("PowerPoint.Application")
Everything else remains the same. The resulting chart now looks like this
Note that it now extends off the bottom of the slide.
Any ideas as to what that's about?
It seems that you've changed your declarations to late-binding, but you may still be using some of the PowerPoint constants (such as ppPasteMetafilePicture), which will no longer resolve to their early-bound values, and instead default to 0.
You'll need to define a local constant for ppPasteMetafilePicture in order for the value to be available.
As an aside, you should always use Option Explicit and then the VBE will automatically spot usages of undeclared constants.
Related
I am trying to add a slide in a Presentation but I am having an error.
Context:
I have a word file that contains more than 200 pages. Each page contains an image (a screenshot). I want to create a PowerPoint document and for each images in the MS Word document; I want to paste the picture in a blank layout slides.
Sub transfert_image_from_WORD_to_PowerPoint()
'I added a Reference Object to this Module (PowerPoint)
'Variable creation
Dim pptPres As PowerPoint.Presentation
Dim pptApp As PowerPoint.Application
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True
Set pptPres = pptApp.Presentations.Add
'add Slides
Dim pptSlide As Slide
Dim pptLayout As CustomLayout
Set pptLayout = ActivePresentation.Slides(0).CustomLayout
'Set pptSlide = ActivePresentation.Slides.AddSlide(0, pptLayout)
'Word object creation to contains images.
Dim pic As InlineShape
Dim pslides As Slides
'loop through eanch Picutures in MS Word
For Each pic In ActiveDocument.InlineShapes
pic.Select
Selection.Copy
'Selection.PasteAndFormat wdPasteDefault
Next
End Sub
I have an error in the line Set pptLayout
Not sure why you aer using ActivePresentation when you create a Presentation object. Anyway, here is how you can add a slide. You use the Add method of the CustomeLayouts collection, then you can add a slide
Set pptLayout = pptPres.SlideMaster.CustomLayouts.Add(1)
Set pptSlide = pptPres.Slides.AddSlide(1, pptLayout)
I'm trying to use VBA to copy data from excel to powerpoint. I've got the following code which I believe should work but it keeps giving me an error even though I've declared and specific all of the variables.
Sub CopyToPPT()
Dim DestinationPPT As String
Dim rng As Range
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim mySlide As Object
Dim myShape As Object
Dim myShapeRange As Range
DestinationPPT = "C:\powerpoint.pptx"
'Open Powerpoint
Set myPresentation = PowerPointApp.Presentations.Open(DestinationPPT)
Set rng = ThisWorkbook.ActiveSheet.Range("B2:D14")
Set mySlide = myPresentation.Slides(5)
Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
'Copy
rng.copy
'Paste
mySlide.Shapes.PasteSpecial DataType:=2
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
myShapeRange.Left = 234
myShapeRange.Top = 186
End Sub
It doesn't seem to like the line
Set myPresentation = PowerPointApp.Presentations.Open(DestinationPPT)
Any idea how I can fix this? When I try running it I get the error:
Run-time error '91':
Object variable or With block variable not set
First of all, i'd strongly recommend to read about Early and late binding
You have to create new instance of PowerPoint application before you'll try to open presentation.
This should work:
'your code
Set PowerPointApp = New PowerPoint.Application
'the rest of your code
'Open Powerpoint
Set myPresentation = PowerPointApp.Presentations.Open(DestinationPPT)
I want to know how I can create a new PPT from Excel VBA (I already have the code) but without seeing the app while it is creating. I have found some insights but it only works when it opens an existing PPT file, but I am creating a new file.
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptShape As PowerPoint.Shape
Dim excelTable As Excel.Range
Dim SlideTitle As String
Dim SlideText As String
Dim SlideObject As Object
Dim pptTextbox As PowerPoint.Shape
Dim SlideNumber As String
On Error Resume Next
Set pptApp = New PowerPoint.Application
Err.Clear
Set pptPres = pptApp.Presentations.Add
pptPres.PageSetup.SlideSize = ppSlideSizeOnScreen
Calling .Active on a PowerPoint.Application does just that - it activates it, which makes the window visible:
Dim ppt As PowerPoint.Application
Set ppt = New PowerPoint.Application
Debug.Print ppt.Visible '<--Prints 0 (msoFalse)
ppt.Activate '<--THIS SHOWS THE WINDOW.
Debug.Print ppt.Visible '<--Prints -1 (msoTrue)
Just remove the pptApp.Activate line completely.
As mentioned in the comments, you also need to fix your error handler. In this case, the best fix is by removing it completely. GetObject returns an existing instance if it exists. I'm assuming that when you say "create a new PPT" that you don't mean "attach to a running PowerPoint instance if it exists, otherwise create a new one". That is what your code currently does.
Also as mentioned in the comments, if you have a reference to Microsoft PowerPoint X.X Object Library (as evidenced by Dim pptApp As PowerPoint.Application), you shouldn't be using CreateObject either. That's for late-binding. If you have a reference, use early-binding.
Finally, when you create a PowerPoint.Application, it's not visible by default. You can "fix" your code by reducing it to this one line:
Set pptApp = New PowerPoint.Application
I'm current using vba to automate the creation of a ppt report. I need to copy charts from excel and paste into ppt. I successfully used the ExecuteMso "PasteExcelChartSourceFormatting" to paste the chart in, which I need to use so I can paste while keeping the source formatting and embedding the workbook, but I keep getting an error after that when my code tries to reposition the chart in ppt.
See code:
Sub Update()
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Set ppApp = New PowerPoint.Application
ppApp.Visible = True
ppApp.Activate
Set ppPres = ppApp.Presentations.Open("C:\Users\ashah\Documents\Advisory.pptx")
ppPres.Slides(1).Shapes(7).Delete
Sheet1.ChartObjects("Chart 24").Chart.ChartArea.Copy
ppPres.Slides(1).Select
DoEvents
ppApp.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"
ppApp.CommandBars.ReleaseFocus
DoEvents
ppPres.Slides(1).Shapes(7).Left = _
(ppPres.PageSetup.SlideWidth / 2) - (ppPres.Slides(1).Shapes(7).Width / 2)
ppPres.Slides(1).Shapes(7).Top = 77
End Sub
I get a run-time error '--2147188160 (80048240)', method 'Item' of object 'Shapes' failed. The debug highlights the last few lines of my code.
Any advice would be greatly appreciated!
I know this is a little late to the game, but I used this post to try and answer the same problem I was having. And I wanted to pay it forward when I found the solution.
Now my code is a little different because I'm creating a new slide for every chart in my excel worksheet, but I too need to keep the source formatting.
Dim PowerPointApp As Object
Dim CurrentSlide As Object
Dim PowerPointDoc As Object
Dim xChart As ChartObject
Dim wb As Workbook
Dim ws As Worksheet
Dim Chart As ChartObject
Dim Sheet As Worksheet
Dim x As Long
Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet
Set PowerPointApp = CreateObject("Powerpoint.Application")
Set PowerPointDoc = PowerPointApp.Presentations.Add(msoTrue)
PowerPointApp.Visible = True
For Each Chart In ws.ChartObjects
PowerPointApp.ActivePresentation.Slides.Add
PowerPointApp.ActivePresentation.Slides.count + 1, 12
Set CurrentSlide = PowerPointDoc.Slides(PowerPointDoc.Slides.count)
CurrentSlide.Select
Chart.Copy
PowerPointApp.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"
'**********************************
Do
DoEvents
Loop Until CurrentSlide.Shapes.count > 0
'**********************************
Next Chart
The "Do While Loop" has helped avoid this error. It does take some time for the macro to finish depending on how many charts you have.
Can you try this, slightly different method
Sub Update()
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Set ppApp = New PowerPoint.Application
ppApp.Visible = True
ppApp.Activate
Set ppPres = ppApp.Presentations.Open("C:\Users\ashah\Documents\Advisory.pptx")
Set ppSlide = ppPres.Slides(1)
ppSlide.Shapes(7).Delete
Sheet1.ChartObjects(1).Chart.ChartArea.Copy
ppSlide.Shapes.Paste.Select
With ppPres.Windows(1).Selection.ShapeRange
.Left = (ppPres.PageSetup.SlideWidth / 2) - (.Width / 2)
.Top = 77
End With
End Sub
UPDATE:
I split this into two subs. Can you give this a try
Sub Update()
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Set ppApp = New PowerPoint.Application
ppApp.Visible = True
ppApp.Activate
Set ppPres = ppApp.presentations.Open("C:\Users\ashah\Documents\Advisory.pptx")
Set ppSlide = ppPres.Slides(1)
ppSlide.Shapes(7).Delete
Call CopyAndPasteChart(ppApp, ppSlide)
With ppSlide.Shapes(ppSlide.Shapes.Count)
.Left = (ppPres.PageSetup.SlideWidth / 2) - (.Width / 2)
.Top = -77
End With
ppApp.CommandBars.ReleaseFocus
End Sub
Sub CopyAndPasteChart(ppApp As PowerPoint.Application, ppSlide As PowerPoint.Slide)
Sheet1.ChartObjects(1).Chart.ChartArea.Copy
ppApp.CommandBars.ExecuteMso ("PasteExcelChartSourceFormatting")
End Sub
You could edit the CopyAndPasteChart Sub a bit more if you fancied to make it usable in more situations.
I currently have a powerpoint with a chart that was generated through an excel.
What I need to do is get the values of the chart (or the excel, doesn't matter) in order to do some animations.
The problem is that I can't seem to get my code to work.
If there is ANY easier way to do this I will be glad to hear it!
Here's my code:
Sub moveRectangle()
Dim pptChart As Chart
Dim pptcd As ChartData
Dim xlWorkbook As Object
Dim PPPres As Presentation
Dim pptShape2 As Shape
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim sld As Slide
Dim shp As Shape
Dim PPApp As PowerPoint.Application
'Look for existing instance
On Error Resume Next
Set PPApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0
'Create new instance if no instance exists
Set PPApp = CreateObject("Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
Set pptShape = PPPres.Slides(1).Shapes("Rectangle 16")
Set pptShape2 = PPPres.Slides(1).Shapes("Chart 3")
Set pptChart = pptShape2.Chart
Set pptcd = pptChart.ChartData
MsgBox (pptShape2.Name)
Set wb = pptcd.Workbook
Set ws = wb.Worksheets(1)
pptShape.Left = pptShape.Left - 40
End Sub
The problem is that I'm getting the following error:
Method 'Workbook' of Object 'ChartData' failed
Any help is greately appreciated!
In order to get it working without "activating" excel (which exists full screen mode, pretty annoying), what must be done is adding
With pptChart.ChartData
...
End With
This allows you to get the same functionalities without having to "activate excel"