I want to use a template to copy data from EXCEL to a POWERPOINT presentation with EXCEL VBA. It works when I use an explicit path. However I want to use a relative path to run it, but its throw me the following error
Sub PowerPoint()
Dim rng As Excel.Range
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim mySlide As PowerPoint.Slide
Dim myShapeRange As PowerPoint.Shape
Dim Template As String
'Copy Range from Excel
Set rng = Worksheets("Contact Page").Range("C2:O38")
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
'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
'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate
'Create a New Presentation
Template = CurDir()
Template = Template & "\TEMPLATE3.potm"
Set myPresentation = PowerPointApp.Presentations.Add
myPresentation.ApplyTemplate (Template)
'myPresentation.ApplyTemplate ("C:\Users\Oriol\Documents\3mundi\Reporting\BR\New Model\TEMPLATE3.potm")
myPresentation.PageSetup.SlideSize = ppSlideSizeOnScreen
Error
What Should I do?
Assuming the template file is in the same folder of the Excel file, change the statement:
Template = CurDir()
to:
Template = ThisWorkbook.Path
Is the Excel file in the same locations as your potm? CurDir() returns the path that the excel file is currently saved in. So if your potm is saved in a subfolder, you will want to use that sub-folder in the path as well:
Template = CurDir()
Template = Template & "\SubFolder\TEMPLATE3.potm"
Related
I am calling VBA code from an Excel spreadsheet to open an existing PowerPoint file via the Presentations.Open method. In my environment I developed via Early Binding using the MS PowerPoint 14.0 Object Library and the codes run without a problem.
However, when the script was called in another machine that runs MS Office 2013 (i.e. MS PowerPoint 15.0 Object Library), a Run-time error pops up
Method 'Open' of object 'Presentations' failed
Is the Presentations.Open method deprecated in PPT 15.0 Object library? I tried searching Internet but couldn't find documentation on the change.
I also attempted to use Late Binding to see if it works, but received the same error.
Please find below the code snipnets I used (early + late binding).
Thank you very much for the help.
Early Binding Code Snipnet
Sub EarlyBinding()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim PowerpointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Set PowerpointApp = New PowerPoint.Application
PowerpointApp.Visible = True
Dim myPath As String
myPath = ws.Range("wk_dir").Value & "\" & ws.Range("ppt_name").Value
Set myPresentation = PowerpointApp.presentations.Open(myPath)
myPresentation.SaveAs (ws.Range("wk_dir").Value & "\test_earlybind.pptx")
Set myPresentation = Nothing
Set PowerpointApp = Nothing
End Sub
Late Binding Code Snipnet
Sub LateBinding()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim PowerpointApp As Object
Dim myPresentation As Object
Set PowerpointApp = CreateObject("Powerpoint.Application")
PowerpointApp.Visible = True
Dim myPath As String
myPath = ws.Range("wk_dir").Value & "\" & ws.Range("ppt_name").Value
Set myPresentation = PowerpointApp.presentations.Open(myPath)
myPresentation.SaveAs (ws.Range("wk_dir").Value & "\test_latebind.pptx")
Set myPresentation = Nothing
Set PowerpointApp = Nothing
End Sub
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 have a little issue with my macro. I know it's not the perfect one but at least it works.
The only thing is that when I go step by step it is going perfectly but when I run it all the new slides are blank.
Do you have an idea how to improve that ?
Sub paste_toPPT()
Dim PowerPointApp As Object
Dim pptApp As Object
Dim pptPres As Object
Dim myRange As Excel.Range
Dim path As String
Dim DestinationPPT As String
Dim saveName As String
Dim image As Object
Dim IDe As String
Dim count As Integer
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set pptApp = GetObject(Class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If pptApp Is Nothing Then Set pptApp = CreateObject(Class:="PowerPoint.Application")
'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
'Open template
DestinationPPT = "C:\Users\user\Desktop\ID Card\Kpi ID.pptx"
Set pptPres = pptApp.Presentations.Open(DestinationPPT)
Windows("KPI List - P2P KPI.xlsm").Activate
count = WorksheetFunction.CountA(Sheets("KPI List").Range("E:E")) - 1
For i = 8 To count
Worksheets("KPI List").Select
'ThisWorkbook.Sheets("KPI List").Select
IDe = Worksheets("KPI List").Range(Cells(i, 5), Cells(i, 5))
ThisWorkbook.Sheets("ID").Range("F4:F4") = IDe
'Set the range to copy
Windows("KPI List - P2P KPI.xlsm").Activate
Worksheets("ID").Select
Worksheets("ID").Shapes.Range(Array("Group 57")).Select
Selection.Copy
'Add slide & Paste data
pptPres.Windows(1).Activate
Set mySlide = pptPres.Slides.Add(1, 12)
mySlide.Select
pptApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
Next i
pptPres.SaveAs DestinationPPT
End Sub
Try the code below, explanations inside the code as comments:
Sub paste_toPPT()
Dim pptApp As Object
Dim pptPres As Object
Dim myRange As Excel.Range
Dim path As String
Dim DestinationPPT As String
Dim saveName As String
Dim image As Object
Dim IDe As String
Dim count As Integer
' added 2 worksheet objects
Dim wsKPI As Worksheet
Dim wsID As Worksheet
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set pptApp = GetObject(, "PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If pptApp Is Nothing Then Set pptApp = CreateObject("PowerPoint.Application")
'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
'Open template
DestinationPPT = "C:\Users\user\Desktop\ID Card\Kpi ID.pptx"
Set pptPres = pptApp.Presentations.Open(DestinationPPT)
' no need to Activate the workbook first, just set the worksheet objects
Set wsKPI = Workbooks("KPI List - P2P KPI.xlsm").Sheets("KPI List")
Set wsID = Workbooks("KPI List - P2P KPI.xlsm").Sheets("ID")
count = WorksheetFunction.CountA(ws.Range("E:E")) - 1
For i = 8 To count
IDe = wsKPI.Range(wsKPI.Cells(i, 5), wsKPI.Cells(i, 5))
wsID.Range("F4:F4") = IDe
' first add the slide , later do the copy>>paste as close as can be
Set mySlide = pptPres.Slides.Add(1, 12)
' Set the range to copy (no need to Select first)
wsID.Shapes.Range(Array("Group 57")).Copy
mySlide.Select
pptApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
Next i
pptPres.Save
End Sub
I am trying to convert all pptx files in a give path to pdf files.
my code:
Sub pptxtopdf()
Dim ppt As Object
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
On Error Resume Next
Set ppt = GetObject(, "PowerPoint.Application")
If ppt Is Nothing Then
Set ppt = CreateObject("PowerPoint.Application")
End If
On Error GoTo 0
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("P:\Operations\Data & Deliverables\Projects\Amica\presentation_workspace\1_ spring 2015\Presentations\Volvo")
i = 1
'loops through each file in the directory
For Each objFile In objFolder.Files
Set WDReport = ppt.Presentations.Open(objFile.Path)
Dim FileName2 As String
FileName2 = Replace(objFile.Path, "pptx", "pdf")
'WDReport.ExportAsFixedFormat FileName2, ppFixedFormatTypePDF
WDReport.SaveAs FileName2, ppSaveAsPDF
WDReport.Close
ppt.Quit
Set ppt = Nothing
Set WDReport = Nothing
i = i + 1
Next objFile
End Sub
error msg
Presentation.SaveAs : Invalid enumeration value.
Cannot see what I'm doing wrong?
same problem as here but the solution didnt work for me - Excel macro to save pptx as pdf; error with code
You are late binding PowerPoint.Application so its enumeration values are not exposed or available in the global VBA namespace.
As you have not added option explicit to warn you of undeclared variables your use of the undeclared ppSaveAsPDF causes no error but has no value.
Add:
const ppSaveAsPDF as long = 32
To the top of the module to provide the expected value to SaveAs.
I am updating a powerpoint presentation using vba.
There are 30 charts in the ppt and I will be coping the data from some excel sheets to the backend excel sheets of the powerpoint charts. but each time I do it, I can see the new excel sheets getting opened in the taskbar. even though they don't display on the whole screen
Set CExcel = New Excel.Application
CExcel.Visible = False
Set CWB2 = CExcel.Workbooks.Open(PPPres.Slides(lngSldNo).Shape(strChartName).Chart.ChartData.Workbook)
This is the code I am using, but it is giving me error that you can not open a file like this
can you tell me how the backend sheets of powerpoint charts can be opened in a new instance and without displaying the file and its tab also
Thanks in advance
The 1st argument to the Workbooks.Open method is a string containing the file path, e.g.
Sub Test()
Dim EAPP As Excel.Application, EWB As Excel.Workbook
Set EAPP = New Excel.Application
Set EWB = EAPP.Workbooks.Open("C:\Users\Myself\Desktop\MyFile.xlsx")
Set EWB = Nothing
Set EAPP = Nothing
End Sub
Not sure that is delivered by your argument. The Application.Visible property by default is False, so no need to explicitely set it. And I guess you have created a reference to the Excel Object Library to make use of the Excel objects in Powerpoint for early binding.
Logic:
Get the shape which has the Chart object
Get your Chart object and then Get the Chartdata
Launch the chart and set your workbook and your Excel application objects
Assumptions:
For demonstration purpose I am assuming the following
Slide1 in the presentation has one shape which is a chart
I have added both scenarios. i.e Automating Excel from PowerPoint and Automating PowerPoint from Excel
Is this what you are trying?
Code: Automating Excel from PowerPoint
Option Explicit
Sub Sample()
'~~> Excel Objects
Dim oXlApp As Object, oXlWb As Object, oXlSheet As Object
'~~~> Powerpoint objects
Dim oPPChart As Chart
Dim oPPChartData As ChartData
'~~> Working with shape1
With ActivePresentation.Slides(1).Shapes(1)
If .HasChart Then
Set oPPChart = .Chart
Set oPPChartData = oPPChart.ChartData
oPPChartData.Activate
'~~> Set your Excel objects here
Set oXlWb = oPPChartData.Workbook
Set oXlApp = oXlWb.Parent
oXlApp.Visible = False
Debug.Print oXlApp.Name
Debug.Print oXlWb.Name
'
'~~> Rest of your code
'
End If
End With
'~~> Close And Cleanup
oXlWb.Close False
oXlApp.Quit
Set oXlSheet = Nothing
Set oXlWb = Nothing
Set oXlApp = Nothing
End Sub
CODE: Automating PowerPoint from Excel
Option Explicit
Sub Sample()
'~~> Excel Objects
Dim oXlApp As Application, oXlWb As Workbook, oXlSheet As Worksheet
'~~~> Powerpoint objects
Dim oPPApp As Object, oPPprsn As Object, oPPSlide As Object
Dim oPPChart As Object, oPPChartData As Object
Application.ScreenUpdating = False
'~~> Establish a Popwerpoint application object
On Error Resume Next
Set oPPApp = GetObject(, "PowerPoint.Application")
'~~> If not found then create new instance
If Err.Number <> 0 Then
Set oPPApp = CreateObject("PowerPoint.Application")
End If
Err.Clear
On Error GoTo 0
'~~> open relevant powerpoint file
Set oPPprsn = oPPApp.Presentations.Open("C:\Presentation1.pptx")
Set oPPSlide = oPPprsn.Slides(1)
'~~> Working with shape1
With oPPSlide.Shapes(1)
If .HasChart Then
Set oPPChart = .Chart
Set oPPChartData = oPPChart.ChartData
oPPChartData.Activate
'~~> Set your Excel objects here
Set oXlWb = oPPChartData.Workbook
Set oXlApp = oXlWb.Parent
'~~> This is required if powerpoint chartdata
'~~> opens in the same instance of this excel
oXlWb.Windows(1).Visible = False
'oXlApp.Visible = False
Debug.Print oXlApp.Name
Debug.Print oXlWb.Name
'
'~~> Rest of your code
'
End If
End With
oXlWb.Windows(1).Visible = True
'~~> Close And Cleanup
oXlWb.Close False
oPPprsn.Close
oPPApp.Quit
Application.ScreenUpdating = True
Set oPPChartData = Nothing
Set oPPChart = Nothing
Set oPPChartData = Nothing
Set oPPSlide = Nothing
Set oPPprsn = Nothing
Set oPPApp = Nothing
End Sub