This macro is one that was not written by me, so I'm having trouble understanding the source of the error. I have a macro that's supposed to run on startup to adjust the ribbon to add a button, and another part to remove styles when you select that button. Currently, I get the message: Object variable or With block variable not set. When I select "Debug" it goes to the VBA screen and immediately gives me 3 more error pop-ups that say: Can't execute code in break mode.
The first part of this is the two subs that are to run on startup, which are:
Dim WithEvents app As Application
Private Sub App_WorkbookActivate(ByVal Wb As Workbook)
Module1.MyRibbon.Invalidate
End Sub
Private Sub Workbook_Open()
Set app = Application
End Sub
It highlights the Module1.MyRibbon.Invalidateas the problematic bit. Personally I don't see anything wrong with this per se, but perhaps the problem is in the Module 1? That code contains three subs, as follows:
Public MyRibbon As IRibbonUI
'Callback for customUI.onLoad
Sub CallbackOnLoad(Ribbon As IRibbonUI)
Set MyRibbon = Ribbon
End Sub
'Callback for customButton getLabel
Sub GetButtonLabel(control As IRibbonControl, ByRef returnedVal)
If ActiveWorkbook Is Nothing Then
returnedVal = "Remove Styles"
Else
returnedVal = "Remove Styles" & vbCr &
Format(ActiveWorkbook.Styles.Count, "#" & Application.International(xlThousandsSeparator) & "##0")
End If
End Sub
Sub RemoveTheStyles(control As IRibbonControl)
Dim s As Style, i As Long, c As Long
On Error Resume Next
If ActiveWorkbook.MultiUserEditing Then
If MsgBox("You cannot remove Styles in a Shared workbook." & vbCr & vbCr & _
"Do you want to unshare the workbook?", vbYesNo + vbInformation) = vbYes Then
ActiveWorkbook.ExclusiveAccess
If Err.Description = "Application-defined or object-defined error" Then
Exit Sub
End If
Else
Exit Sub
End If
End If
c = ActiveWorkbook.Styles.Count
Application.ScreenUpdating = False
For i = c To 1 Step -1
If i Mod 600 = 0 Then DoEvents
Set s = ActiveWorkbook.Styles(i)
Application.StatusBar = "Deleting " & c - i + 1 & " of " & c & " " & s.Name
If Not s.BuiltIn Then
s.Delete
If Err.Description = "You cannot use this command on a protected sheet. To use this command, you must first unprotect the sheet (Review tab, Changes group, Unprotect Sheet button). You may be prompted for a password." Then
MsgBox Err.Description & vbCr & "You have to unprotect all of the sheets in the workbook to remove styles.", vbExclamation, "Remove Styles AddIn"
Exit For
End If
End If
Next
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
I've never written any Activation or Ribbon-related macro, so I have no idea where the error could be. The addin works just find regardless of this message, as the button gets added and it functions as it should when the file isn't a blank file, but I get the error pop-up and the button doesn't get created right on new, blank files. How could I fix this?
I simply deleted:
Private Sub App_WorkbookActivate(ByVal Wb As Workbook)
Module1.MyRibbon.Invalidate
End Sub
No runtime errors on start of excel and no issues when using the script; counts fine and deletes fine. Windows 7, Excel 2010.
Related
I am trying to assign an opened workbook to an workbook object. If that workbook is not already opened, then it throws an error. I am handling the errors using an Error Handler.
This works for me:
On Error GoTo OpenWorkbookError
Set Uwk = Application.Workbooks(WbkName)
OpenWorkbookError:
If Err <> 0 Then
Err.Clear
MsgBox ("Please Open the Required Workbook")
Exit Sub
End If
But is there a way to avoid using the error handlers in this situation.
One way to do it is check each workbook name, but what's wrong with the functions in the link that #SJR gave?
In your provided code you've kept the error handler within the main body of code - it should appear between the Exit Sub and End Sub at the end of the procedure.
Something like this would work without an error handler, but it's slower as it needs to check each workbook:
Sub Test()
Dim Uwk As Workbook
Dim WbkName As String
WbkName = "PERSONAL.XLSB"
For Each Uwk In Workbooks
If Uwk.Name = WbkName Then
Exit For
End If
Next Uwk
If Not Uwk Is Nothing Then
MsgBox Uwk.Name & " found!"
Else
MsgBox "Not found."
End If
End Sub
Your version of the code should have the error handler outside the main body:
Sub Test1()
Dim WbkName As String
Dim UWk As Workbook
WbkName = "PERSONAL1.XLSB"
On Error GoTo OpenWorkbookError
Set UWk = Workbooks(WbkName)
TidyExit:
'Close anything that needs closing and Exit.
Exit Sub '<< End of main body of procedure.
OpenWorkbookError:
Select Case Err.Number
Case 9 'Subscript out of range.
MsgBox "Please open the required workbook."
Resume TidyExit
Case Else
MsgBox "Error " & Err.Number & vbCr & _
Err.Description, vbOKOnly + vbCritical
Resume TidyExit
End Select
End Sub '<< End of procedure.
When a user opens my VBA program it hides all Excel's command bar's and whatnot so it looks as if my program is not running in Excel at all. Since this action will take place across all instances of Excel I found some code that will check if other programs are open, and if so save my program as a temp file and reopen it in a new instance of Excel.
The problem though is when it opens it doesn't fire off the Workbook_Open event. As a temporary fix I've put a button on a spreadsheet that runs the macro to launch the program but I need to do better than this. Can you take a look at the code at this site and let me know why the Workbook_Open event is not firing? (as you can see I've already asked the forum twice for help on it with no response).
Updated with code
The code that duplicates the program and opens the new instance is in the UserForm section of code at the bottom.
Placed in ThisWorkbook:
Private Sub Workbook_Open()
Set clsAPP.XLAPP_ORIG = Application
If Application.UserControl Then
If Application.Workbooks.Count > 1 Then
Application.Visible = False
DoEvents
frmCreateReplicant.Show vbModal
End If
End If
Call ThisWorkbook_CompleteOpening
End Sub
Placed in standard module:
Option Explicit
Public XLAPP_Copy As New Excel.Application, _
clsAPP As New clsXLApp
Public Sub ThisWorkbook_Open()
Dim intMaxRow As Integer
If Application.Workbooks.Count > 1 Then
Application.Visible = False
DoEvents
frmCreateReplicant.Show vbModal
'Call ThisWorkbook_CompleteOpening
Else
ThisWorkbook_CompleteOpening
End If
ThisWorkbook.Saved = True
Delay
End Sub
Sub ThisWorkbook_CompleteOpening(Optional Fake)
'MsgBox "...Any other OnOpen code here..."
End Sub
Function Delay(Optional SecondFraction As Single = 0.2)
Dim sngTimeHack As Single, dtmDate As Date
sngTimeHack = Timer: dtmDate = Date
If sngTimeHack + SecondFraction < 86400 Then
Do
DoEvents
Loop While Timer < (sngTimeHack + SecondFraction)
Else
If dtmDate = Date Then
Do
DoEvents
Loop While dtmDate = Date
End If
sngTimeHack = (sngTimeHack + SecondFraction) - 86400
If DateAdd("d", 1, dtmDate) = Date Then
Do
DoEvents
Loop While Timer < sngTimeHack
End If
End If
End Function
Function KillMeBasic()
With ThisWorkbook
.Saved = True
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close False
End With
End Function
Placed in class module:
Option Explicit
Public WithEvents XLAPP_ORIG As Application
Private Sub XLAPP_ORIG_NewWorkbook(ByVal Wb As Workbook)
Wb.Close False
MsgBox MsgTxt(1), 64, vbNullString
End Sub
Private Sub XLAPP_ORIG_WorkbookOpen(ByVal Wb As Workbook)
If Not Wb.Name = ThisWorkbook.Name Then
Wb.Close False
MsgBox MsgTxt(2), 64, vbNullString
End If
End Sub
Private Function MsgTxt(Opt As Long) As String
Select Case Opt
Case 1
MsgTxt = _
"Sorry, you cannot create a new workbook here." & vbCrLf & _
"You can start a new instance of Excel by..."
Case 2
MsgTxt = _
"You cannot open another workbook here. You" & vbCrLf & _
"can open another workbook by first..."
End Select
End Function
Placed in UserForm:
Private Sub UserForm_Activate()
Dim strThisWorkbookFullname As String
Dim wbMeCopy As Workbook
Delay 0.05
Set XLAPP_Copy = CreateObject("Excel.Application")
strThisWorkbookFullname = ThisWorkbook.FullName
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\00000000001.xls", _
Password:="NeedKilled", AddToMru:=False
Application.DisplayAlerts = True
Do While ThisWorkbook.Saved = False
Loop
Delay 0.2
XLAPP_Copy.Workbooks.Open Filename:=strThisWorkbookFullname, AddToMru:=False
Do
On Error Resume Next
Set wbMeCopy = XLAPP_Copy.Workbooks(1)
On Error GoTo 0
Loop While wbMeCopy Is Nothing
Set wbMeCopy = Nothing
Delay 0.1
Application.Visible = True
XLAPP_Copy.Visible = True
Unload Me
Delay
Call KillMeBasic
End Sub
Private Sub UserForm_Initialize()
With Me
.BackColor = &H0&
.Caption = ""
.ForeColor = &H0&
.Height = 123
.Width = 240
With .lblMsg
.BackColor = &H0&
.Caption = String(2, vbCrLf) & _
"Please wait, I am protecting the program..."
With .Font
.Name = "Century Gothic"
.Size = 10
End With
.ForeColor = &HC000C0
.Height = 90
.Left = 6
.TextAlign = fmTextAlignCenter
.Top = 6
.Width = 222
End With
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu _
Then Cancel = True
End Sub
This works to hide the Ribbon/command bars (although the File or Backstage menu is still present, thought I think you may be able to disable this I have not tried yet), if you are hiding other stuff like the StatusBar, etc., it may not be enough to solve your problem, but here it is anyways.
Using the CustomUI editor, open the XLSM file.
Note: The XLSM file should not be open in any instance of Excel when you are opening it through the Custom UI Editor. If it is open in Excel, the modifications to the XML will not be saved properly.
Once you have the file open in the CustomUI Editor, you'll see this:
From the menu, Insert Office 2010 Custom UI Part:
Then copy and paste this XML:
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
<ribbon startFromScratch="true" />
</customUI>
Finally, save & close the file through the CustomUI Editor, then re-open in Excel. You should see that the while this file/workbook is active, the ribbon does not exist.
But, if you switch to another Workbook file, the ribbon will re-appear while that file is active.
The startFromScratch property makes it so that when this Workbook has focus, the only ribbon elements which are displayed to the user, within the Application's window, are those which are defined within the XML, which as you can probably gather in the snippet above, are none.
This also entirely avoids the need to try and open copies of the file in a new instance of Excel Application, which (unless you have some other quirky requirements) seems unnecessarily cumbersome and problematic.
First time posting so please be kind.
From a template file, I am running a macro to create a new folder with a copy of the template file in it. I then rename it and update it. At one point, I need to manually download a file from a website and open it and then start another macro to finish the update.
I initially tried to do that from one unique macro but I got issues as the macro would keep running before the excel file had time to open.
I have now split my macro in 2. At the end of the 1st macro, I call a userform with instructions and a continue button. The idea is that I would download the file while the userform is opened and click on "continue" when the file is opened.
For some reason, the file does not open at all. It seems like either the userform or the macro stops the file from opening. However, If I run it using the debug function, It works fine...
Public strSN As String, strPart As String, strPath As String
Sub create_new()
' Create Folder if it doesn't exist
'Dim strSN As String, strPart As String, strPath As String
'strSN = SerialNumber.Value
'strPart = PartNumber.Value
'strPath = "M:\Quality\QUALITY ASSURANCE\DOC\Rental Folder\Scanned MRB's\"
' close userform
welcomeform.Hide
'set Microsoft scription runtime reference to allow creation of folder macro
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromGUID "{420B2830-E718-11CF-893D- 00A0C9054228}", 1, 0
On Error GoTo 0
If Not FolderExists(strSN) Then
'Serial Number folder doesn't exist, so create full path
FolderCreate strPath & strSN
End If
' Create new file in new folder
On Error Resume Next
ActiveWorkbook.SaveCopyAs Filename:=strPath & strSN & "\" & strPart & " " & strSN & " " & "SNR.xlsm"
If Err.Number <> 0 Then
MsgBox "Copy error: " & strPath & "TEMPLATE SNR.xlsm"
End If
On Error GoTo 0
' open new file without showing it or opening macros
Application.EnableEvents = False 'disable Events
Workbooks.Open Filename:=strPath & strSN & "\" & strPart & " " & strSN & " " & "SNR.xlsm"
Application.EnableEvents = True 'enable Events
' Modify serial number and part number in traceability summary form
Sheets("Traceability Summary Form").Activate
Sheets("Traceability Summary Form").Unprotect
Range("A7").Value = strSN
Range("C7").Value = strPart
' update file with ITP
Call Download_itp
End Sub
Sub Download_itp()
downloaditp.Show
End Sub
In the download_itp userform:
Sub continue_Click()
Call update_traceable_items
End Sub
Then the 2nd macro starts with code:
Sub update_traceable_items()
'
' Macro to update the SNR tab with the traceable items from the ITP
'
downloaditp.Hide
' copy ITP in file
Application.ActiveProtectedViewWindow.Edit
ActiveSheet.Name = "ITP"
ActiveSheet.Copy after:=Workbooks(strPart & " " & strSN & " " & "SNR.xlsm").Sheets("SNR template")
Any help would be appreciated!
Thanks
The UserForm is being displayed modally, which probably prevents you from "opening" the recently downloaded file. When UserForm is displayed modally, the user is prevented from "interacting" with any part of Excel Application that is not the UserForm itself -- so you can't select cells or worksheets, you can't open files or close files, etc.
This is the default behavior for UserForms, but fortunately there is an optional parameter for the .Show method which allows you to display the form "modelessly":
downloaditp.Show vbModeless
This allows you to interact with the Excel Application while the form is open.
Note: If the file is on a shared network location, you can probably handle this better by using a FileDialog object to allow you to "browse" to the location of the file, and open it, all within the scope of your main procedure, like:
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count <> 1 Then
MsgBox "No file selected!", vbCritical
Exit Sub
Else
Dim NewWorkbook as Workbook
Set NewWorkbook = Workbooks.Open(.SelectedItems(0))
End If
End With
I have a spreadsheet with 6 userforms, used on about 30 computers. The VBA code is password protected. Often when we close the sheet, the VBA project password box appears and excel.exe remains in task manager.
I have done a bit of testing and come up with the following:
The problem only occurs when a userform has been opened.
Nothing needs to be done with the userform to cause the popup other than to press Cancel (which calls Unload Me)
The Workbook_BeforeClose event is as follows:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
'Cancel autosave
Sheets("BOH General").Range("A102").Value = 0
AutoSaveTimer
'Application.EnableEvents = False
If Not Sheets("START").Visible = True Then Call CostingMode
Call BackItUp
'Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
And here are some other macros called by Workbook_BeforeClose:
Sub AutoSaveTimer()
If Sheets("BOH General").Range("A102").Value > 0 Then
RunWhen = Now + TimeSerial(0, Sheets("BOH General").Range("A102").Value, 0)
Application.OnTime EarliestTime:=RunWhen, Procedure:="AutoSaveIt", _
Schedule:=True
Else
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:="AutoSaveIt", _
Schedule:=False
On Error GoTo 0
End If
End Sub
Sub AutoSaveIt()
ThisWorkbook.Save
Call AutoSaveTimer
End Sub
Sub BackItUp()
'Dont run if unsaved
If Sheets("BOH General").Range("A111").Value = "" Then Exit Sub
'Prompt
If MsgBox("Do you want to backup this sheet now (recommended if you made any changes)?", vbYesNo) = vbNo Then Exit Sub
'reformat date
Dim DateStamp As String
DateStamp = Format(Now(), "yyyy-mm-dd hh-mm-ss")
On Error Resume Next
MkDir ActiveWorkbook.Path & "\" & "Backup"
On Error GoTo 0
ActiveWorkbook.SaveCopyAs (ActiveWorkbook.Path & "\" & "Backup" & "\" & ActiveWorkbook.Name & " - backup " & DateStamp & ".xlsb")
ActiveWorkbook.Save
End Sub
Is this a userform error, is the userform not closing properly? Or is it something else?
UPDATE: This error only occurs after the user clicks the excel close button (top right) clicking File>Close does not produce the error.
Interesting that I have been experiencing the same instance, it has only cropped up recently as well. Did a version of MOS change this behavior? I have users on Excel 12.0.6611.1000 and 12.0.6712.5000 that do not get this error, on 12.0.6729.5000 it always occurs.
Edit;
I resolved this issue on my end today after discovering that several users had 'Drop Box' installed. Uninstalling or turning off drop box just prior to closing the application resolved the issue.
This question already has answers here:
Why VBA goes to error handling code when there is no error?
(5 answers)
Closed last year.
I have my code below, the strange thing is that the Errorhandler procedure is still executing even though there are no errors in the code... What can be the issue?
Running the code without any errorhandlers generates no errors, but still the msgbox under Errorhandler shows up when I include an error handling statement!
Code
Public Sub ExportGraphs(Optional PivotExport As Boolean)
' Exports only graphs on the "Mainwindow" sheet to a new worksheet
Dim wsh As Worksheet: Set wsh = Sheets.Add
Dim source_sht As Worksheet: Set source_sht = Sheets("Mainwindow")
ActiveWindow.Zoom = 70
On Error GoTo Errorhandler
With wsh
If source_sht.OLEObjects("Btn_CurrentTime").Object.Value = True Then
.Name = source_sht.OLEObjects("CombBox_Instruments").Object.Value & " " & source_sht.OLEObjects("DTPicker_FROM").Object.Value _
& "-" & source_sht.OLEObjects("DTPicker_TO").Object.Value
Else
.Name = source_sht.OLEObjects("CombBox_Instruments").Object.Value & " " & "Max_Possible_To" _
& "-" & source_sht.OLEObjects("DTPicker_TO").Object.Value
End If
End With
Dim source_chart As ChartObject
Dim target_rng As Range: Set target_rng = wsh.Range("A1")
For Each source_chart In source_sht.ChartObjects
source_chart.CopyPicture xlScreen, xlBitmap
target_rng.PasteSpecial
Set target_rng = target_rng.Offset(20, 0)
Next
If PivotExport = True Then
Debug.Print "se"
End If
Errorhandler:
MsgBox "An export sheet for this ticker and timeline already exists"
End Sub
#dee provided the correct answer.
The Errorhandler: is just a place holder. It does NOT operate like you think. You are using it like an If... Then... statement:
If Error Then
Show MsgBox
Else
Skip MsgBox
End If
As the Errorhandler is just a placeholder and NOT an If... Then..., the code after the placeholder will run regardless of error or no error. To rectify this issue, add an Exit Sub above the Errorhandler: line:
Exit Sub
Errorhandler:
MsgBox "An export sheet for this ticker and timeline already exists"
End Sub
In this piece of code, ErrorHandler: is what is known as a line label.
Errorhandler:
MsgBox "An export sheet for this ticker and timeline already exists"
End Sub
Line labels are not executable code, but rather just a marker that can tell other code where to jump to via any GoTo Statement. Armed with this knowledge, they are obviously not exclusive to error handlers.
The solution here is to use the Exit Statement to return from the Sub "early".
Exit Sub
Errorhandler:
MsgBox "An export sheet for this ticker and timeline already exists"
End Sub
Others may disagree with me, but I like to build my error handling so that the code always stops execution on Exit Sub. If the code ends its execution on End Sub, something has gone wrong.