I'm trying to apply a template to a powerpoint through excel. The powerpoint template is embedded within my excel file via insert -> Object. I've successfully used the .applytemplate method to apply a template from file, but I cannot adjust the code to reference the embedded powerpoint template. I tried using OLEObject, but I'm afraid that isn't correct. Please review below code.
Sub ppCreate()
Dim myPP As PowerPoint.Application
Dim myPres As PowerPoint.Presentation
Dim activeSlide As PowerPoint.Slide
Dim ppObj As OLEObject
' Create instance of PowerPoint
Set myPP = CreateObject("Powerpoint.Application")
' For automation to work, PowerPoint must be visible
myPP.Visible = True
' Create a presentation
Set myPres = myPP.Presentations.Add
' Set slide view to Slide Only
myPP.ActiveWindow.ViewType = ppViewSlide
'Resize to 4:3
myPres.PageSetup.SlideSize = 2
'Add a slide
Set activeSlide = myPres.Slides.Add(1, ppLayoutBlank)
'Import Template
Worksheets("CBRDATA").Select
Set ppObj = ActiveSheet.OLEObjects("ppObj") 'NOT WORKING
myPres.ApplyTemplate (ppObj) 'NOT WORKING
myPres.ApplyTemplate "C:\CBR_TEMPLATE_COVER.potx" 'WORKING
Worksheets("CBR").Select
End Sub
Update:
'Test if template exists in C:\
If Dir("C:\CBR_TEMPLATE_COVER.potx") = "" Then
'Open/Save the embedded template to C:\
Set tempPP = CreateObject("Powerpoint.Application")
Worksheets("CBRDATA").OLEObjects("ppObj").Verb 0
tempPP.Visible = True
Set tempPres = tempPP.ActivePresentation
tempPres.SaveCopyAs ("C:\CBR_TEMPLATE_COVER.potx")
tempPres.Close
Else:
End If
' Create instance of PowerPoint
Set myPP = CreateObject("Powerpoint.Application")
This doesn't work because ActiveSheet.OLEObjects("ppObj") is type OLEObject, not PowerPoint.Presentation.
Set ppObj = ActiveSheet.OLEObjects("ppObj") 'NOT WORKING
While manually double-clicking on the object open the POTX file (actually it opens a new blank PPTX using the POTX as template), your assignment statement above isn't doing any of that, it's trying instead to put an OLEObject where a Presentation is expected, and that will always fail.
So, how to "open" the OLEObject? OLEObject has a .Verb method, and the following will perform the object's default action, which in the case of embedded package objects, is usally to "open" them.
The Solution
'Import Template
'## This should Open the template
Worksheets("CBRDATA").OLEObjects("ppObj").Verb 0
'## Assign the ActivePresentation to your ppObj variable
Set ppObj = myPP.ActivePresentation
Editorializing: Embedded OLEObjects are notoriously problematic, and probably not an ideal place to story things like document templates :)
Related
I want to run VBA code from a certain powerpoint file on an external powerpoint file without copying the code into the external powerpoint file. I wish to only open the original powerpoint file containing the code and run it from there, it should point to the external powerpoint file and alter it directly. How to do this?
So far I am doing it like this:
'For each file, if powerpoint run remove alt text macro
For Each FSOFile In FSOFolder.Files
'Insert the actions to be performed on each file
sFileExtension = FSOFile.GetExtensionName()
If sFileExtension = "pptm" Or sFileExtension = "pptx" Or sFileExtension = "ppt" Then
Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
PPT.Presentations.Open (FSOFile.Path)
' Note that the file name and the module
' name are required to path the macro correctly.
PPT.Run (ActivePresentation.Path + "!Module1.BlankAllTheAltText")
filesAltered = filesAltered + 1
End If
Next
I don't think this is correct. Any suggestions?
Since you're already running this from within PPT, you don't need to create a PPT application object. Try something more like this:
Dim oPres As Presentation
'For each file, if powerpoint run remove alt text macro
For Each FSOFile In FSOFolder.Files
'Insert the actions to be performed on each file
sFileExtension = FSOFile.GetExtensionName()
If sFileExtension = "pptm" Or sFileExtension = "pptx" Or sFileExtension = "ppt" Then
Set oPres = Presentations.Open(FSOFile.Path)
' Alter BlankAllTheAltText to take a presentation object
' as a parameter
Call BlankAllTheAltText(oPres)
filesAltered = filesAltered + 1
oPres.Save
oPres.Close
End If
Next
Why is following code running from MS Word (MailMerge main document) freezing the application on ThisDocument.Close False?
Do I need to close the Scripting.Dictionary in some way other than setting the object to nothing?
There is only one instance of Word active, it is visible, ThisDocument is not the active document.
I am even explicitly activating the last opened document, even if it is already active. Not sure if I even need to set the oWorkbook and oExcel to nothing.
Sub MailMergeAlternative()
Dim oExcel As Object
Dim oWorkbook As Object
Dim oFirstCell As Object
Set oExcel = CreateObject("Excel.Application")
Set oWorkbook = oExcel.workbooks.Open(SOUBOR)
Set oFirstCell = oWorkbook.sheets(SESIT).Cells(1, 1)
Dim Dict As Object
Set Dict = MakeDictionary() ' Scripting.dictionary
Dim oDoc As Object
Dim Radek As Long
Dim Radku As Long
Radku = oFirstCell.currentregion.Rows.Count
For Radek = 2 To Radku
' ... fill Dict, use MailMerge to create new document for active record ...
Set oDoc = ActiveDocument ' the new document after MailMerge
' ... insert values, save the new document, do not close it ...
Next
Closing:
oDoc.Activate ' <== set to active, not needed
Set Dict = Nothing
oWorkbook.Close
oExcel.Quit
Set oWorkbook = Nothing ' probably not needed, closed above
Set oExcel = Nothing ' probably not needed, closed above
ThisDocument.Close False ' <== Problem
End Sub
Expected:
The code runs, creates new document(s) and closes the document which is containing the macro and from where it was called. The last active document stays open (the newly created one), or if nothing was created, Word app closes.
What is happening:
The document closes, the last active document stays open. But Word freezes and the document needs to be found in Task Manager and "brought to foreground". This is not a problem when using MailMerge alone (with additional vba work) and seems to be connected to use of Excel and Scripting.Dictionary.
Since you don't provide a [mcve] so that we can test exactly what you're doing it's possible that the following solution won't work for your exact environment. My test was run on the code below, which essentially creates a number of new documents then closes a document. (I have no access to your Excel content or to MakeDictionary())
I created a template (dotm) and put the code in that, closed it, created a new document from the template. This document has access to the code, via its link to the template. Closing the document will also release the template (unless another document based on it is opened). But in my test the code finished without an error.
Sub TestCloseSelfDocument()
Dim docMmMainMerge As Word.Document
Set docMmMainMerge = ActiveDocument
Dim Dict As Object
Dim oDoc As Object
Dim Radek As Long
Dim Radku As Long
Radku = 5
For Radek = 2 To Radku
Documents.Add
' ... fill Dict, use MailMerge to create new document for active record ...
Set oDoc = ActiveDocument ' the new document after MailMerge
' ... insert values, save the new document, do not close it ...
Next
Closing:
Set Dict = Nothing
docMmMainMerge.Close False
End Sub
Try to open embedded object in excel file with caption,able to open file with name: can any one help how to open with caption or dynamically
Worksheets(SheetName).Activate
Set o = Worksheets(SheetName).OLEObjects("object 3")
o.Verb xlVerbOpen
MsgBox "Attachmene open"
Note: object will add continuously in excel file, how to find object dynamically to open with caption?
The embedded object in Excel is a Shape. Add two embeded workbooks in your ActiveSheet and try this code:
Public Sub TestMe()
Dim obj As Object
For Each obj In ActiveSheet.Shapes
Debug.Print obj.Application.Caption
Next obj
End Sub
Then try to change the code, with a simple condition, opening the obj, if the caption is the expected one:
If obj.Application.Caption = "someCaption" Then OpenTheWorkbook(obj)
At the end write some check to make sure that it skips some possible errors.
I open an embedded WORD document through Excel using the following verb command.
Set o = .OLEObjects("Object 1")
o.Verb xlVerbOpen
"Object 1" is the default name of the embedded object so that would be changed as needed.
I hope someone can help....
I have a powerpoint presentation, which has linked tables and graphs from an excel file. the updating of the slides are set to manual.
i have created a VBA code in Powerpoint which opens up the excel file. I am trying to update the links in the powerpoint through VBA instead of manually choosing each linked element and updating the values. while the first part of my VBA code works in opening up the excel file, the links are not being updated, which i think is down to not being back in the powerpoint to update the links, so I am trying to include in my VBA code lines which will go back to the powerpoint presentation, after which i assume the the line to update links will work (happy to be corrected). below is the code i have built so far....my comments are in bold ...
any suggestions?
FYI, I am using office 2007.
Thanks
Sub test()
Dim xlApp As Object
Dim xlWorkBook As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkBook = xlApp.Workbooks.Open("File location\filename.xlsm", True, False)
Set xlApp = Nothing
Set xlWorkBook = Nothing
Section above opens the excel file which contains the linked tables and charts
On Error Resume Next
With GetObject(, "PowerPoint.Application")
.ActivePresentation.SlideShowWindow.Activate
End With
Section above i was hoping would go back to the powerpoint after opening the excel file but it does not which is why i think the code below to update links is not working
ActivePresentation.UpdateLinks
End Sub
Start from something easier. This will allow you to activate the first existing PowerPoint application from Excel:
Option Explicit
Public Sub TestMe()
Dim ppt As New PowerPoint.Application
ppt.visible = msoTrue
ppt.Windows(1).Activate
End Sub
Then play a bit with it and fix it into your code.
#Vityata
Ok, i got it to work....original coding did the first part of opening the excel file, and to switch back to powerpoint (and i think this will only work if there is only 1 presentation open i added the following code...
AppActivate "Microsoft PowerPoint"
so my complete code looks like:
Sub test()
Dim xlApp As Object
Dim xlWorkBook As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkBook = xlApp.Workbooks.Open("file path\file name.xlsm", True, False)
Set xlApp = Nothing
Set xlWorkBook = Nothing
AppActivate "Microsoft PowerPoint"
End Sub
now to get manual links to update as part of the vba code...
If you capture the file that your macro is in. This is just a string of your path and filename
'This is the macro file
MacroFile = ActivePresentation.FullName
Then you can use that variable to activate just that specific PowerPoint presentation.
Use Presentations(MacroFile).Activate
or Presentations(MacroFile).Updatelinks
It's best not to use ActivePresentation when moving between applications.
I'm trying to copy slide 1 from external ppt to current ppt into notes page. However, I'm getting this error msg:
Slides (unknown member) : Invalid request. Clipboard is empty or
contains data which may not be pasted here.
The external ppt from where I'm copying does contains the data.
VBA script:
Sub copySlide()
Dim objPresentation As Presentation
Set objPresentation = Presentations.Open("/path/slides.ppt")
objPresentation.Slides.Item(1).Copy
Presentations.Item(1).Slides.Paste
objPresentation.Close
End Sub
Try the code below, I hope your presentation at ("/path/slides.ppt") doesn't throw an error.
I added 2 options, either place it at the end, or as the second slide - you can modify the Paste line easily
Code
Sub copySlide()
Dim MyPres As Presentation
Dim objPresentation As Presentation
Set MyPres = ActivePresentation
Set objPresentation = Presentations.Open("/path/slides.ppt")
objPresentation.Slides(1).Copy
'MyPres.Slides.Paste MyPres.Slides.Count + 1 ' <-- place it at the end
MyPres.Slides.Paste 2 ' <-- place it as the second slide
objPresentation.Close
Set objPresentation = Nothing ' clear object
End Sub