Turning Display Alerts off in PowerPoint from Excel - excel

I am writing a macro that opens and closes a PowerPoint Presentation from Excel.
Now I have the issue that when I am trying to save the PowerPoint file I get a pop up Message Box. To take care of that issue I used:
Application.DisplayAlerts = False
However this works in some cases, as I loop through multiple Presentations but not in all. So I tried instead this:
pptPres.Application.DisplayAlerts = False
But this just caused the Display Alerts to always pop up.
So I tried to replicate that using
Application.DisplayAlerts = True
which did not work. So I am quite confused what I am doing wrong. I need to turn the DisplayAlerts off otherwise my macro is stopped.
The issue occurs as I am opening a PowerPoint with macros so a *.pptm file which on saving I am asked whether or not to save with macros.
This is my current code, maybe you can replicate the issue:
Dim pptPres As PowerPoint.Presentation
Set pptApp = CreateObject("powerpoint.Application")
Set pptPres = pptApp.Presentations.Open(strPfad & strDat, False, True, True)
pptPres.Application.DisplayAlerts = False
strFirma = "Test123"
pptPres.SaveAs strPfad + "\Berichte" & "\" & strFirma & ".pptx"
pptPres.Close
Any help is greatly appreciated.

Powerpoint's Application.DisplayAlerts is slightly different. It has two options: ppAlertsAll and ppAlertsNone.
Try pptApp.DisplayAlerts = ppAlertsNone. Note that you have a mix of early- and late-binding and probably should be consistent. If you go with late-binding, ppAlertsAll's corresponding value is 2, and ppAlertsNone's corresponding value is 1.
Thanks to #Matthieu Guindon for pointing out that since you're running this from Excel, Application refers to Excel.Application, which is not your instance of PowerPoint. Hence Application.DisplayAlerts will not affect PowerPoint's alert setting at all. You want to work with pptApp, the instance of PowerPoint.

Related

I can't update worksheets objects links on powerpoint VBA - OneDrive Folder

I've already read in the forums but noone has my exactly problem, so here we go.
I have my excel and powerpoint files in a OneDrive folder (the Powerpoint is in subfolder), the powerpoint has 100 links.
So, in a forum someone suggested that to get the local OneDrive path, you should turn off the process. I did it.
I have to have the excel file open, because the processing time is really slow if the excel is closed. So If I have opened the excel file and run the macro (in other folder diferent to OneDrive) it runs ok, but if I try to do the same but in the OneDrive folder, it generated the next error into the code line pptShape.LinkFormat.Update:
Error -2147188160 (80048240) in runtime. LinkFormat (unknown member):
Invalid request. The linked file was unavailable and could not be
updated
If I have the excel file closed, the macro runs ok, but the process is so slow (almost 30 minuts), because it open and close the excel a hundred times.
does anyone knows why it happened? How can I fix it? I'll appreaciate your help. here is the code to update the links
Sub updatelinks_1()
Call Shell("cmd.exe /S /C" & "%LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /shutdown")
Application.DisplayAlerts = ppAlertsNone
Dim pptPresentation As Presentation
Dim pptSlide As Slide
Dim pptShape As Shape
'Set the variable to the PowerPoint Presentation
Set pptPresentation = ActivePresentation
'Loop through each slide in the presentation
For Each pptSlide In pptPresentation.Slides
'Loop through each shape in each slide
For Each pptShape In pptSlide.Shapes
'Find out if the shape is a linked object or a linked picture
If pptShape.Type = msoLinkedOLEObject Then
Dim name, path1, path2, source, begin, search1, cells As String
Dim limit1 As Integer
name = pptShape.LinkFormat.SourceFullName
limit1 = InStr(1, name, "!")
cells = Right(name, Len(name) - limit1)
search1 = "subfoldername"
path1 = Application.ActivePresentation.FullName
begin = InStr(1, path1, search1)
begin = Left(path1, begin - 1)
file1 = Dir(begin & "*.xlsm")
source = begin & file1
End If
path2 = source & "!" & cells
pptShape.LinkFormat.SourceFullName = path2
'update method. code line where generate error
pptShape.LinkFormat.Update
End If
Next
Next
'Update the links (If I use this method on OneDrive folder, it doesn't work and broke all the links because replace the Link name with only the excel file name, not the sheets and cells)
' pptPresentation.UpdateLinks
Call Shell("cmd.exe /S /C" & "start %LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /background")
Set pptPresentation = Nothing
Set pptSlide = Nothing
Set pptShape = Nothing
Application.DisplayAlerts = ppAlertsAll
End Sub
Good morning everyone.
As I have not seen the solution, I'd like to add my 2 cents.
I have had a similar issue, on a win10 Platform running Office 365.
In my case both files are on the same laptop.
I have seen that the powerpoint VBA procedure to update the path takes a long time by default. ( around 4 Minutes for me as there are 22 linked Objects).
One can speed it up by manually open the target excel file before launching the Powerpoint VBA.
It becomes effectively faster but I hit the issue where for each link the ppt vba procedure tries to update, we get a pop up window telling us that Excel can't open 2 files with same name.
I've tried to add in the PowerPoint VBA procedure : Application.DisplayAlerts = False , but is logically inefficient as applies to the PPT application and not to the Excel app !
I finally found one quick (and logic) solution :
at the beginning of the PowerPoint VBA, I ask user to locate the target excel file :
Set XlApp = CreateObject("Excel.Application")
ExcelFile = XlApp.GetOpenFilename(, , "Would you please locate your excel File")
And after, I just Open the target file, and set it with displayLAerts to False.
XlApp.Visible = True
Set xlWorkbook = XlApp.Workbooks.Open(ExcelFile, True, False)
Doing so, I no longer get warnings.
Full source code available .
Wish you a nice day !

VBA in Access Looping through multiple excel workbooks Subscript out or Range error

I have been working with this issue for days. I tried multiple different ways. I am attempting to append multiple files into an Access linked table or even a temp table or even into a single excel file. At first EVERY SINGLE TIME on the first attempt the program works perfectly, then after that it stops functioning for a period of time and then starts operating again. When it stop functioning I get an Subscript out of range run-time error 9.I open the proper excel file but for some reason it won't let me set it... How can it OPEN THE FILE but in the next line CAN'T FIND IT??? It is driving me insane, it works, it stops working, then it works again... Any advice or hints would be very much appreciated.
This is just one way I tried to do this but they all end the same.
i = 2 'i is created through another loop previously.
j = 0
With MyXL
.Visible = True
.DisplayAlerts = True
End With
Do
Set MyXL = CreateObject("Excel.Application")
MyXL.Workbooks.Open Directory & fileArray(j), Notify:=False, ReadOnly:=False 'Tried True previously but changed since i was making changes to the file.
Set wb = Workbooks(fileArray(j)) 'DING DING DING!!! WHY??? You WORKED before!!!
If wb.Sheets("Sheet1").Range("A1") = "System Status" Then
wb.Sheets("Sheet1").Range("A1") = "PO System Status"
wb.Save
End If
wb.Close True
Set wb = Nothing
MyXL.Quit
Set MyXL = Nothing
Set wb = Nothing
j = j + 1
Loop Until j = i
Previously I thought I wasn't closing the workbook correctly, but I have closed the MyXL and previous wb but i still run into the error. I was wondering if this is something that Access/vba just can't do in succession as well. I changed the ReadOnly to true and it still ends up the same way.
Set your workbook to the return value from the Open method:
Set wb = MyXL.Workbooks.Open(Directory & fileArray(j), Notify:=False, ReadOnly:=False)
If wb.Sheets("Sheet1").Range("A1") = "System Status" Then
wb.Sheets("Sheet1").Range("A1") = "PO System Status"
wb.Save
End If
You don't need to/shouldn't create a new Excel application instance for every file - set that up before you enter the loop, and close it once you're done updating files. Check your Task Manager and make sure you don't have a bunch of Excel instances hanging around.

GetOpenFileName opens in background

I have a macro that prompts the user to select a comma separated values file, however, whenever the macro runs, it opens the window behind all the other open windows. The macro is never called from excel, but only by other scripts. I've tried messing with Application.DisplayAlerts and Application.ActiveWindow but to no avail. Any suggestions are greatly appreciated.
Function folderselection()
Dim fnameandpath As Variant
Dim path As String
Dim objshell As Object
Set objshell = CreateObject("wscript.shell")
objshell.AppActivate "excel"
Application.DisplayAlerts = False
path = ActiveWorkbook.path
ChDrive (path)
ChDir (path)
Application.ActiveWindow.Visible = True
Application.WindowState = xlMaximized
fnameandpath = Application.GetOpenFilename(FileFilter:=("BOM CSV/RPT (*.CSV;*.RPT), *.CSV; *.RPT"), Title:="Select The BOM File To Copy Values From")
Application.WindowState = xlMinimized
If fnameandpath = False Then Exit Function
Workbooks.Open Filename:=fnameandpath, ReadOnly:=True
Application.DisplayAlerts = True
folderselection = CStr(fnameandpath)
ActiveWorkbook.Close
End Function
Looking at some sections of your code:
Function folderselection()
Dim fnameandpath As Variant
...
fnameandpath = Application.GetOpenFilename(...
...
folderselection = CStr(fnameandpath)
These lines are redundant. This accomplishes the same thing with half the code (and is therefore simpler):
Function folderSelection() as String
...
folderSelection = Application.GetOpenFilename(...
Dim path As String
path = ActiveWorkbook.path
ChDrive (path)
ChDir (path)
These lines accomplish nothing. The GetOpenFilename dialog defaults to the same folder as ActiveWorkbook.Path.
Dim objshell As Object
Set objshell = CreateObject("wscript.shell")
objshell.AppActivate "excel"
These lines don't do anything either. I think you might be trying to activate the existing Excel window? If so, you need to read the documentation for these commands.
I guarantee you don't have a Title Bar called excel. You might have one called "Book1.xlsm - Excel", but that's irrelevant because you don't need to activate the current window unless you were using another application in the 0.01 seconds since you [I assume] manually executed this procedure.
Furthermore, objects need to be handled certain ways, such as freeing up the memory when you're finished with them (ie, Set ... Nothing; see "crashes" below) otherwise, some processes will just remain in memory, taking up space, until you reboot.
It's important to understand that some commands should be at least partially understood before arbitrarily using them, since you could have unexpected results. In this case the Windows Script Host (wscript), as well as calling "outside" command-line programs (shell.exe) can/will impact other applications and/or cause crashes.
Application.DisplayAlerts = False
Application.DisplayAlerts = True
This isn't accomplishing anything related to what you're trying to do (and certain setting should be used sparingly or not at all -- like disabling warnings or security alerts in code that isn't functioning properly to begin with. Just leave those lines out.
Application.ActiveWindow.Visible = True
The Active Window is, by definition, Visible already. This line does nothing.
Application.WindowState = xlMaximized
Application.WindowState = xlMinimized
Seriously? Obviously these "cancel each other out", not to mention that the "last" one leaves the window minimized. Isn't "not being able to see the window" your main issue?
fNameAndPath = Application.GetOpenFilename(FileFilter:=("BOM CSV/RPT (*.CSV;*.RPT), *.CSV; *.RPT"), Title:="Select The BOM File To Copy Values From")
Ironically, the command that you figured is the problem, is actually the only line that was functioning properly (regardless of minor syntax and organization issues). Little things like spacing and using "exact documented syntax" canm end up having an an impact on the success of your code, and are especially important while still in the troubleshooting stage.
Matching the command's documentation, plus changing the destination as mentioned above:
folderSelection = Application.GetOpenFilename("Comma Separated Files (*.csv),*.csv,Report Files (*.rpt),*.rpt.", 1, "Select the Source BOM File")
If fNameAndPath = False Then Exit Function
Nothing wrong with that line! Personally, I would use:
If Not fNameAndPath Then Exit Function
...but the result is the same.
Workbooks.Open Filename:=fNameAndPath, ReadOnly:=True
Following the documentation, a better way to phrase that line would be:
Workbooks.Open Workbooks.Open fNameAndPath, , True, 2
The 2 specifies comma delimiting. Since you specified that the file is comma-separated, I will assume that the other option you specified (an ".RPT" file) is also a text-based, comma-separated file.
That line probably would have functioned okay as it was, which is good since it's a key part of your subroutine.
Except that, 0.01 seconds later, the very last command closes the file that you just opened:
ActiveWorkbook.Close
With VBA and/or Excel there are often (usually?) multiple ways to accomplish the same task, adding to flexibility and ease-of-use that have made Excel common-place on almost "every desk and in every home." [Anyone else catch that reference?!]
Unfortunately the flip side (very common around here) is users over-complicating tasks unnecessarily; even [unknowingly] attempting to build functionality from scratch - that's already built-in to Excel and the rest of the Office Suite.

How to save workbook and handle TITUS (or any other document classification add-in) popup?

I'm creating a script in HP UFT 12 which performs grid data validation against a CSV file and saves the results in a Excel file with two worksheets.
I'm using Excel for this because it is much more clear for the user, as it allows cell formatting, is easier to compare the data and so forth.
My code works in my machine, but my client has TITUS document classification add-in installed, so every time they run my script, it hangs because of the TITUS pop-up message that asks user to classify the document upon saving. The message is not displayed to the user, probably because of objExcel.DisplayAlerts = False, but the script does not move forward.
Following is the portion of my code which is related to the matter (I have omitted most of the code, for confidentiality reasons).
Dim objExcel : Set objExcel = CreateObject("Excel.Application")
Dim objWorkbook : Set objWorkbook = objExcel.Workbooks.Add
objExcel.Visible = False
Dim wsGrid : Set wsGrid = objWorkbook.Worksheets(1)
wsGrid.Name = "Grid Data"
Dim wsExported : Set wsExported = objWorkbook.Worksheets.Add
wsExported.Name = "Exported Data"
' Internal code to perform validation and fill worksheets ...
objExcel.DisplayAlerts = False
objWorkbook.SaveAs "C:\my_folder_path\my_file_name.xls" ' This is where it hangs in machines where the add-in is installed
objWorkbook.Close
objWorkbook.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
I have searched online but haven't find anything related to it so far. I did find this and this, but they are related to TITUS for Outlook and in neither one the issue is properly solved.
Does anyone know how to solve this, or can point me to a research material to help me solve this issue?
Thanks in advance.
As ridiculously simple as it looks (I don't know how I haven't thought of this before), I manage to solve my issue by simply adding objExcel.EnableEvents = False before saving the file:
objExcel.DisplayAlerts = False
objExcel.EnableEvents = False ' this is the problem solver for the matter!
objWorkbook.SaveAs "C:\my_folder_path\my_file_name.xls"
objExcel.EnableEvents = True ' Not sure if this statement is necessary, though
objWorkbook.Close
objWorkbook.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
So far as I can tell, none of the above answers actually classify the Excel workbook (and I found this on our work intranet having failed to find any code on the internet).
The code below should set Classification as Internal which can be amended as you need, and will also create the footer text based on 'ClassificationVal'.
Code then sets the classification, adds the left footer and removes the annoying page breaks at the same time (note: setting classification automatically sets page breaks).
Disabling events before save seems to be the only way to avoid the pop up box...
Note: you will need to replace '[Company Name]-' with e.g. 'IBM-' (if your company adds it's name to the classification, and delete '[Company Name]-' if they use the TITUS classification only. Also, the classifications seem to be bespoke to each company from my experience, so you may need to update accordingly.
ClassificationVal = "[Company Name]-1nternal"
ClassificationDesc = "[Company Name]: "
ClassificationDesc2 = ""
Select Case ClassificationVal
Case "[Company Name]-1nternal"
ClassificationDesc2 = "Internal"
Case "[Company Name]-pub1ic"
ClassificationDesc2 = "Public"
Case "[Company Name]-Confidentia1"
ClassificationDesc2 = "Confidential"
Case "[Company Name]-5ecret"
ClassificationDesc2 = "Secret"
Case "[Company Name]-pr1vate"
ClassificationDesc2 = "Private"
End Select
If ClassificationDesc2 = "" Then Stop
ClassificationDesc = ClassificationDesc & ClassificationDesc2
With ActiveWorkbook.CustomDocumentProperties
.Add Name:="[Company Name]Classification", _
LinkToContent:=False, _
Type:=msoPropertyTypeString, _
Value:=ClassificationVal
End With
For Each ws In ActiveWorkbook.Worksheets
ws.PageSetup.LeftFooter = ClassificationDesc
ws.DisplayPageBreaks = False
Next ws
Application.EnableEvents = False 'disable TITUS pop-up
ActiveWorkbook.SaveAs Filename:= _
"C:\Data\kelvinj\My Documents\TITUS Test.xlsx", 'Change to suite your requirements
FileFormat:=xlOpenXMLWorkbook _
, CreateBackup:=False
Application.EnableEvents = True
Not sure why this is so hard to find a solution to - this is the 2nd multinational company I've worked for to be infected by TITUS, so there must be loads of people needing this code surely?!
I am not a VBA coder but my friends were working on this
The solution we found was on the behaviour of Titus
It will ask you to classify any new workbook when u save it. Note new not an already saved workbook.
So we created a blank workbook and saved it(with the required classification)
Amended the code to take that workbook and add data to it and using save as to create the required files
It works smoothly without any issues.

Run Powerpoint sub from Excel VBA

I need to run a PowerPoint sub from a sub in Excel. The reason is that most PowerPoint actions run far faster and with less errors when run from a sub in PowerPoint than when run from a sub in Excel.
I am trying to use Application.Run(Macroname_As_String) where I use PptApp in place of Application and PptApp is loaded as:
Dim PptApp As PowerPoint.Application
Set PptApp = CreateObject("PowerPoint.Application")
I tried referring to the VBA script as both Presentation1.pptm!UpdateOLELinks and UpdateOLELinks ie. file and VBA script / just VBA script.
I get the error :
"Method 'Run' of object '_Application' failed".
My VBA script UpdateOLELinks is located in Module1 of Presentation1.
Any Ideas?
The Run Method in PowerPoint require parameters : msdn.microsoft.com/fr-fr/library/office/Ff744221.aspx
So, even if you pass an empty array, try something like :
PptApp.Run Macroname_As_String, Parameters_As_Array
Other untested possibilities (with your references for context) I stumbled across while researching :
Dim PptApp As PowerPoint.Application
Set PptApp = CreateObject("PowerPoint.Application")
Set Ppt1 = PptApp.Presentations.Open(PptPath, msoFalse, msoTrue, msoTrue)
'Possibility 1
PptApp.Run Macroname_As_String, Parameters_As_Array
'Possibility 2
Ppt1.PptApp.Run Macroname_As_String, Parameters_As_Array
'Possibility 3
PptApp.Run "'" & Ppt1.name & "'!" & Macroname_As_String, Parameters_As_Array
'Possibility 4
PptApp.Run Module_Name.Macroname_As_String, Parameters_As_Array
'Possibility 5
PptApp.Run "'" & Ppt1.name & "'!" & Module_Name.Macroname_As_String, Parameters_As_Array
I found the answer here, where "UpdateOLELinks" is the name of the PowerPoint sub and the option to compile live as you type has not been disabled (it's enabled by default):
https://www.ozgrid.com/forum/forum/other-software-applications/excel-and-or-powerpoint-help/26816-open-ppt-and-run-a-pre-written-macro
from ASHOK_SHARMA02:
Dim PPApp As PowerPoint.Application
Set PPApp = CreateObject("PowerPoint.Application")
PPApp.AddIns.Application.Run ("UpdateOLELinks"), ""
It worked for me after trying loads of possible solutions.
[edit]
Actually it broke again when running the PPT from the VBA. Reason is VBA module has not yet been activated, so something like PPT doesn't know it exists (crazy huh?).
So, add line
PPApp.VBE.ActiveVBProject.VBComponents.Item("Module1").Activate
There are two issues (which seem unique to PowerPoint), parameters are required and the macro name must be fully qualified.
When qualifying the macro, don't use single quotes as you would for Excel. Instead, just use the following, even if the filename has spaces:
PptApp.Run Ppt1.Name & "!Module1.UpdateOLELinks"
The error will also arise if the parameters being passed don't match the parameters of the macro. Ensure the macro has a defined parameter to receive (of matching type), even if it doesn't use it.
This has been asked long before but still if anyone needs an answer, the follwoing worked for me.
Dim objPP As Object
Dim objPPFile As Object
Set objPP = CreateObject("PowerPoint.Application")
objPP.Visible = True
Set objPPFile = objPP.Presentations.Open(PptPath)
Application.EnableEvents = False
' "filename !Module1.macro_name"
objPP.Run "post_processing_V2.pptm!Module1.code"
objPPFile.Close
objPP.Quit
Set objPPFile = Nothing
Set objPP = Nothing

Resources