Our company has a lot of workbooks that were originally saved in German. Therefore, there is no ThisWorkbook variable. Instead it's called DieseArbeitsmappe. Using ThisWorkbook in code results in VBA an error.
I tried renaming DieseArbeitsmappe to ThisWorkbook with the code below.
Private Sub RenameThisWorkbookToEnglish()
Dim TmpWorkbook As Object
On Error Resume Next
'Was this saved in German?
Set TmpWorkbook = ActiveWorkbook.VBProject.VBComponents("DieseArbeitsmappe")
If err.Number = 0 Then
Debug.Print ("German Workbook.")
TmpWorkbook.Module.CodeName = "ThisWorkbook"
TmpWorkbook.Name = "ThisWorkBook"
TmpWorkbook.CodeName = "This Workbook"
Exit Sub
End If
On Error GoTo -1
End Sub
Function ErrorIsThisWorkBookBad() As Boolean
On Error GoTo ErrLabel
ErrorIsThisWorkBookBad = Not (ThisWorkbook.CodeName = "ThisWorkbook")
Exit Function
ErrLabel:
ErrorIsThisWorkBookBad = True
End Function
I called this code in a Private Sub Auto_Open()
Private Sub Auto_Open()
RenameThisWorkbookToEnglish
If ErrorIsThisWorkBookBad Then
Debug.Print ("Workbook Is Bad.")
End If
End Sub
This code reports as bad. The VBE shows a ThisWorkbook module, but its name is still DieseArbeitsmappe.
Even though the Debug.Print in the Auto_Open reports bad, a later button click function that uses ThisWorkbook is good. Then saving results in multiple ThisWorkbooks (i.e. ThisWorkbook, ThisWorkbook1).
So it kind of works, but not really.
Other notes: I only have English installed on my machine. I do not have access to all of the spreadsheets, but am writing VBA that will be put in them.
Main Question: How to change the localization or ??? to make ThisWorkbook a valid variable?
Thanks to Storax, I found my error.
As noted in the comments, I was receiving a false positive from ErrorIsThisWorkBookBad on the line ThisWorkbook.CodeName = "ThisWorkbook" when ThisWorkbook.CodeName was DieseArbeitsmappe.
I rewrote ErrorIsThisWorkBookBad (below) and tested on a corrupt workbook (i.e. a workbook with ThisWorkbook and ThisWorkbook1 like this). The corrupted workbook did report an error correctly.
Problem solved.
Function ErrorIsThisWorkBookBad() As Boolean
On Error GoTo ErrLabel
'Dummy call just to test if ThisWorkbook creates error.
If ThisWorkbook.Name <> "" Then
End If
'Made it here, there is no error and ThisWorkbook is valid.
ErrorIsThisWorkBookBad = False
Exit Function
ErrLabel:
ErrorIsThisWorkBookBad = True
End Function
Related
Call_Process call multiple macros, each one of them dependent on the previous macro. first macro gets the file location, followed by opening the file in that folder and the final one to close and save changes. The issue is if the opening file isn't there, the following macro will error out. How do I cancel the entire Call_Process if the file isn't located?
Sub Call_Process ()
Call File_Location
Call Open_File
Call Exit_WB
End Sub
**Sub File_Location ()**
location_db = "C:\Users\Documents\New folder\*.xl??"
End Sub ()
**Sub Open_File ()**
dim wb as Workbook
dim ws as Worksheet
if dir(location_db) = "" <- as you can see if the file doesnt exists, it exits out of Open_File sub but not the Exit_WB when im running the Call_Process
end sub
end if
wb_filename = wb.name
sheet_name = ws.name
End Sub
**Sub Exit_WB**
Workbooks(location_db).close savechanges=TRUE
End Sub
Truth be told, you'd need a bit more structure to your application. I don't think it's good practice to call SubProcedures that update global variables (unless there's a specific need for that). Take a look at my below example. Call_Process first asks a function for a file path. If it doesn't get one, the subroutine handles its own error messages. Once the path is available, it calls a function to open a workbook and leave a reference to said workbook. Again, if it doesn't work, the sub can handle it on its own.
Let me know if this helps out.
Sub Call_Process()
Dim filePath As String
Dim wb As Workbook
filePath = GetDatabaseLocation()
If filePath = vbNullString Then
MsgBox "No File"
Exit Sub
End If
Set wb = GetDatabaseWorkbook(filePath)
If wb Is Nothing Then
MsgBox "Sorry, couldn't open this file."
Exit Sub
End If
'Process whatever
wb.Close SaveChanges:=True
End Sub
Private Function GetDatabaseLocation() As String
Dim loc As String
Dim fullPath As String
loc = "c:\TempPath\*.xl??"
'If the file doesn't exist, it will return an empty string
'Otherwise, the file location. NOTE: DIR() returns only the file
'name, so we will append the path below
fullPath = Dir(loc)
If fullPath <> vbNullString Then
fullPath = "c:\TempPath\" & fullPath
End If
GetDatabaseLocation = fullPath
End Function
Private Function GetDatabaseWorkbook(sFilename As String) As Workbook
Dim wb As Workbook
'If there is an error or something, will return 'Nothing'
On Error Resume Next
Set wb = Workbooks.Open(sFilename)
On Error GoTo 0
Set GetDatabaseWorkbook = wb
End Function
You can code with on error also, should be working if error trigger:
Sub Call_Process ()
On Error GoTo ErrorHandler:
Call File_Location
Call Open_File
Call Exit_WB
Exit Sub
ErrorHandler:
End Sub
when you say cancel out... you can use 'END' in the code. This will stop the entire code from running. one note, it wont actually tell you it's stopped so you might want to add a comment as a messagebox or immediate window. code would look something like this:
Sub Call_Process()
Call File_Location
Call Open_File
Call Exit_WB
End Sub
Sub File_Location()
location_db = "C:\Users\Documents\New folder\*.xl??"
End Sub
Sub Open_File()
Dim wb As Workbook
Dim ws As Worksheet
If Dir(location_db) = "" Then
MsgBox "no file location"
End
End If
wb_filename = wb.Name
sheet_name = ws.Name
End Sub
Sub Exit_WB()
Workbooks(location_db).Close savechanges = True
End Sub
Now if you want to expand and get specific messages, i would recommend you change them into functions with outputs/error handling.
I want to apply the error handling mechanism in Excel VBA, I want to catch this "runtime error 9", but it's not working.
I am using this userform_initialize() method/sub over and over again, each time I don't want to open this "SAMPLE UPDATE FILE.xlsm" workbook instead, I want to check if it's already open. if yes, then switch to that window or open that workbook.
I have tried on error resume next statement as well but still, it breaks on switching to window "Windows("SAMPLE UPDATE FILE.xlsm "). Select"
Private Sub UserForm_Initialize()
Application.DisplayAlerts = False
On Error GoTo OPEN_WB_ERR
Windows("SAMPLE UPDATE FILE.xlsm").Select
UserForm1.ComboBox1.RowSource = ("'X:\SAMPLE UPDATE FILE.xlsm'!SEARCH")
Windows("PROFORMA_INVOICE.xlsm").Activate
On Error GoTo 0
Exit Sub
OPEN_WB_ERR:
Workbooks.Open Filename:="X:\SAMPLE UPDATE FILE.xlsm"
UserForm1.ComboBox1.RowSource = ("'X:\SAMPLE UPDATE FILE.xlsm'!SEARCH")
Windows("PROFORMA_INVOICE.xlsm").Activate
Resume Next
End Sub
any advice will be helpful...
Check your setting in the VB editor (Tools >> Options >> General tab >> Error Trapping) for how errors are handled - if you have "Break on all errors" selected then it will always break regardless of any error handling you have set. "Break in Class module" is a good option.
Try,
Private Sub UserForm_Initialize()
Dim path As String, Fn As String
Dim Wb As Workbook
Fn = "X:\SAMPLE UPDATE FILE.xlsm"
Set Wb = Workbooks.Open(Filename:=Fn)
UserForm1.ComboBox1.RowSource = "'" & Fn & "'" & "!SEARCH"
ThisWorkbook.Activate
End Sub
The Initialize event procedure runs when the form is first created, before it is shown. You should open your workbook before creating the form, not as part of that process. Try a procedure like the one below, to be installed in a standard code module.
Sub OpenUserForm()
Dim MyForm As UserForm1
' open your workbook here
Set MyForm = New UserForm1 ' this fires the Initialize event
UserForm1.Show
' the code below runs when MyForm is closed
Unload MyForm
Set MyForm = Nothing
End Sub
Note that a form by the name of UserForm1 must exist. I recommend to give it another, more descriptive name. If you do that whatever name you give is the one to use in the Dim statement declaring MyForm.
I use a WorkbookIsOpen function
Public function WorkbookIsOpen(byval strFile as string) as Boolean
Dim wbkCurr as excel.workbook
WorkbookIsOpen = false
For each wbkCurr in application.Workbooks
If wbkCurr.name = strfile then
WorkbookIsOpen = true
Exit for
Endif
Next wbkCurr
End function
Pass just the file name and extension ie myworkbook.xlsx
Then I just adjust my logic accordingly
I would like to run a particular piece of code if and only if the target file is closed OR was opened by a local VBA macro. If the file is opened by a different user on the network, the code should not run.
So far I have this test code:
Sub refreshAll()
Dim wbIsOpen As Boolean, wbIsOpenByMe As Boolean
Dim fileName As String, filePath As String
Dim testWb As Workbook
fileName = "test.xlsm"
If IsWorkBookOpen(ThisWorkbook.Path & "\" & fileName) Then wbIsOpen = True
On Error Resume Next
Set testWb = Workbooks(fileName)
If Not testWb Is Nothing Then wbIsOpenByMe = True
Err.Clear
On Error GoTo 0
If wbIsOpen = False Or wbIsOpenByMe = True Then
ThisWorkbook.Connections("testcon").OLEDBConnection.BackgroundQuery = False
ThisWorkbook.refreshAll
DoEvents
End If
End Sub
This workaround kind-of-sort-of works, with the exception that it can't tell whether the file was opened manually or by some programmatic agent. Is there a way to do that, or is there an easier way to do what I've tried to do in my code?
If you know the macro which could be opening the file, do you have authority over it? Perhaps just have that macro change some protected value in the workbook - ie: have it add that moment's date and time to a hidden shape's title. Then this macro could check to see if the date and time on the title matches the current date and time (within a processing time margin of error).
This could work something like:
Sub MacroWhichCouldHaveBeenUsedToOpenWorkbook()
'Other code
'Code to open target workbook
Workbooks("TargetWorkbook.xlsx").Sheets(1).Shapes(1).Title = Now()
End Sub
Sub RunIfAutoOpened()
If (Now + #0:00:05#) < Workbooks("TargetWorkbook.xlsx").Sheets(1).Shapes(1).Title Then
'Run desired code
End If
End Sub
As the title say I've been having one particular problem with my userform. When I close it (with a command button) an error pops on Userform.Hide inside the Workbook_Deactivate event.
This is the code on the Userform_initialize event:
All variables in here are global
VBA:
Private Sub Userform_Initialize()
subRemoveCloseButton Me
Set pagina = ThisWorkbook.Worksheets("Ruta")
Set libro = Workbooks.Open(pagina.Range("B4").Value, False, True)
Set pagina2 = libro.Worksheets("GLOBAL")
pasadas = 0
If pagina2.AutoFilterMode Then
If pagina2.FilterMode Then
pagina2.ShowAllData
End If
ElseIf pagina2.FilterMode Then
pagina2.ShowAllData
End If
pagina2.Columns("A:IV").EntireColumn.Hidden = False
lastRow = pagina2.Cells(pagina2.Rows.Count, "B").End(xlUp).Row
Call RemoveDuplicates
With Me.ImagenDatos
.ScrollBars = fmScrollBarsBoth
'Change 8.5 to suit your needs
.ScrollHeight = .InsideHeight * 5
.ScrollWidth = .InsideWidth * 3
End With
End Sub
Then in the CommandButton_Click event I have this:
VBA:
Private Sub BotonCerrar_Click()
Unload Consultas
libro.Saved = True
libro.Close
ThisWorkbook.Close
End Sub
The error, as already commented, comes from this:
VBA:
Private Sub Workbook_Deactivate()
Consultas.Hide
End Sub
If I comment that single line the Userform closes with no problem but I need it so the userform (Consultas) hides when the user switches between workbooks.
The error message says: Object variable or With block variable not set (Error 91)
Anyone have a clue on what's going wrong?
This is my first post and if something else is needed just let me know.
I would appreciate any help on this.
EDIT: I have more code but I think this is pretty much the essential as all I do is open the excel workbook, then the userform shows and then I click the button that closes the userform
So this is how I solved this:
Before trying to hide the userform Consultas on the Workbook_Deactivate event I first checked if the userform was visible with the link provided by #Ralph.
That solved part of the problem but then the error moved to the part where I close libro :
Private Sub BotonCerrar_Click()
Unload Consultas
libro.Saved = True
libro.Close
ThisWorkbook.Close
End Sub
The error persisted even before unloading the userform as suggested by #A.S.H but I fixed it calling Application.Workbooks(libro.Name).Close False instead of libro.close False (If someone could explain this to me I would really appreciated it)
The final code is the following:
Private Sub BotonCerrar_Click()
Dim wb As Workbook
Dim otrolibro As Boolean
otrolibro = False
Application.Workbooks(libro.Name).Close False
Unload Consultas
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then
otrolibro = True
Exit For
End If
Next wb
If otrolibro = True Then
ThisWorkbook.Close False
Else
ThisWorkbook.Saved = True
Application.Quit
End If
End Sub
The For cicle is to quit the excel application if there is not another Workbook open because if I just close all Workbooks, an Excel window remains open with nothing on it.
How can the following conditions be met with VBA code?
A particular worksheet is always displayed on open, even if the worbook is opened without enabling macros.
A workbook user may save the workbook while working on any worksheet.
The save must not interfere with the user - no navigating away to a different sheet, no messageboxes, etc.
The regular save functions (Ctrl-S, clicking Save) must remain available and when used must obey the criteria above.
I'd like to avoid the attempted solutions I've listed at the bottom of this question.
Details:
The workbook is created using Office 2007 on a Windows 7 machine. It is an .xlsm workbook with 2 worksheets, "Scheduler" and "Info." Sheet tabs are not visible. Not all users will enabled macros when the workbook is opened.
Upon opening the workbook, a user will only be exposed to one sheet as follows:
"Info" shows up if macros are disabled, and basically tells anyone who opens the workbook that macros need to be enabled for full workbook functionality. If macros are enabled at this point, "Scheduler" is activated.
"Scheduler" is where data is stored and edited, and is automatically shown if macros are enabled. It is not presented to the user when the workbook is opened without macros enabled.
"Info" must show up first thing if the workbook is opened and macros are disabled.
Attempted Solutions (I'm looking for better solutions!):
Placing code in the Workbook.BeforeSave event. This saves with "Info" activated so it shows up when the workbook is opened. However, if the user is in "Scheduler" and not done, I cannot find a way in this event to re-activate "Scheduler" after the save.
Using Application.OnKey to remap the Ctrl-s and Ctrl-S keystrokes. Unfortunately this leaves out the user who saves using the mouse (clicking File...Save or Office Button...Save).
Checking during every action and if needed activating "Scheduler". In other words, inserting code in something like the Workbook.SheetActivate or .SheetChange events to put "Scheduler" back into focus after a save with "Info" activated. This runs VBA code constantly and strikes me as a good way to get the other code in the workbook into trouble.
Placing code in the Worksheet("Info").Activate event, to change focus back to "Scheduler". This leads to the result of "Scheduler", not "Info", showing when the workbook is opened, even with macros disabled.
Will this not work? Updated to handle Saving gracefully
Private Sub Workbook_Open()
ThisWorkbook.Worksheets("Scheduler").Activate
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Worksheets("Info").Activate
If (ShouldSaveBeforeClose()) Then
Me.Save
Else
Me.Saved = True ' Prevents Excel Save prompt.
End If
End Sub
Private Function ShouldSaveBeforeClose() As Boolean
Dim workbookDirty As Boolean
workbookDirty = (Not Me.Saved)
If (Not workbookDirty) Then
ShouldSaveBeforeClose= False
Exit Function
End If
Dim response As Integer
response = MsgBox("Save changes to WorkBook?", vbYesNo, "Attention")
ShouldSaveBeforeClose= (response = VbMsgBoxResult.vbYes)
End Function
I don't have time to test this out, but you might be able to do this using Application.OnTime in your BeforeSave event handler. Something like:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim objActiveSheet
Set objActiveSheet = Me.ActiveSheet
If objActiveSheet Is InfoSheet Then Exit Sub
If Module1.PreviousSheet Is Nothing Then
Set Module1.PreviousSheet = objActiveSheet
InfoSheet.Activate
Application.OnTime Now, "ActivatePreviousSheet"
End If
End Sub
Then in Module1:
Public PreviousSheet As Worksheet
Public Sub ActivatePreviousSheet()
If Not PreviousSheet Is Nothing Then
PreviousSheet.Activate
Set PreviousSheet = Nothing
End If
End Sub
Edit 2: Here is a re-write that does not utilize AfterSave. You may need to tweak the dialog created from GetSaveAsFilename according to your needs.
This relies on overriding default save behavior and handling the save yourself.
Private actSheet As Worksheet
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
PrepareForSave
manualSave SaveAsUI
AfterSave ThisWorkbook.Saved
End Sub
Private Sub PrepareForSave()
Set actSheet = ThisWorkbook.ActiveSheet
ThisWorkbook.Sheets("Info").Activate
hidesheets
End Sub
Private Sub manualSave(ByVal SaveAsUI As Boolean)
On Error GoTo SaveError 'To catch failed save as
Application.EnableEvents = False
If SaveAsUI Then
If Val(Application.Version) >= 12 Then
sPathname = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsm), *.xlsm")
If sPathname = False Then 'User hit Cancel
GoTo CleanUp
End If
ThisWorkbook.SaveAs Filename:=sPathname, FileFormat:=52
Else
sPathname = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xls), *.xls")
If sPathname = False Then
GoTo CleanUp
End If
ThisWorkbook.SaveAs Filename:=sPathname, FileFormat:=xlNormal
End If
Else
ThisWorkbook.Save
End If
SaveError:
If Err.Number = 1004 Then
'Cannot access save location
'User clicked no to overwrite
'Or hit cancel
End If
CleanUp:
Application.EnableEvents = True
End Sub
Private Sub AfterSave(ByVal bSaved As Boolean)
showsheets
If actSheet Is Nothing Then
ThisWorkbook.Sheets("Scheduler").Activate
Else
actSheet.Activate
Set actSheet = Nothing
End If
If bSaved Then
ThisWorkbook.Saved = True
End If
End Sub
Private Sub hidesheets()
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Info" Then
ws.Visible = xlVeryHidden
End If
Next
End Sub
Private Sub showsheets()
For Each ws In ThisWorkbook.Worksheets
ws.Visible = True
Next
End Sub
Private Sub Workbook_Open()
AfterSave True
End Sub
The only way to make Info display first without macros enabled is if that is how the workbook was saved. This is most reasonably handled when saving.
Unless I misunderstood your issue, not using BeforeSave seems misguided. Just make sure to use AfterSave as well. Here's an example:
Private actSheet As Worksheet
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
showsheets
actSheet.Activate
Set actSheet = Nothing
Thisworkbook.Saved = true 'To prevent save prompt from appearing
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Set actSheet = ThisWorkbook.activeSheet
ThisWorkbook.Sheets("Info").Activate
hidesheets
End Sub
Private Sub Workbook_Open()
showsheets
ThisWorkbook.Sheets("Scheduler").Activate
End Sub
Private Sub hidesheets()
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Info" Then
ws.Visible = xlVeryHidden
End If
Next
End Sub
Private Sub showsheets()
For Each ws In ThisWorkbook.Worksheets
ws.Visible = True
Next
End Sub
The use of the private object actSheet allows the "ActiveSheet" to be reselected after save.
Edit: I noticed you had more requirements in the comments. The code has been updated so that now upon saving, only the Info sheet will be visible, but when opened or after saving, every sheet will reappear.
This makes it so that any user opening the file without macros will not be able to save with a different sheet activated, or even view the other sheets. That would certainly help motivate them to enable macros!
This problem has been flogged to death in the past, its just hard to find a solution that actually works. Take a look at this code which should do what you need. Basically it shows a splash screen, with all other sheets hidden if the user does not enable macros. It will still save normally if the user clicks save and wont interfere with their work. If they save with there worksheet open it will still show only the splash screen when next opened. Download the sample file below and you can test for yourself, make sure you download the file posted by Reafidy it has over 400 views. If you need it modified further let me know.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
bIsClosing = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim wsArray() As Variant
Dim iCnt As Integer
Application.ScreenUpdating = 0
Splash.Visible = True
For Each wsSht In ThisWorkbook.Worksheets
If Not wsSht.CodeName = "Splash" Then
If wsSht.Visible = True Then
iCnt = iCnt + 1: Redim Preserve wsArray(1 To iCnt)
wsArray(iCnt) = wsSht.Name
End If
wsSht.Visible = xlSheetVeryHidden
End If
Next
Application.EnableEvents = 0
ThisWorkbook.Save
Application.EnableEvents = 1
If Not bIsClosing Then
For iCnt = 1 To UBound(wsArray)
Worksheets(wsArray(iCnt)).Visible = True
Next iCnt
Splash.Visible = False
Cancel = True
End If
Application.ScreenUpdating = 1
End Sub
Private Sub Workbook_Open()
Dim wsSht As Worksheet
For Each wsSht In ThisWorkbook.Worksheets
wsSht.Visible = xlSheetVisible
Next wsSht
Splash.Visible = xlSheetVeryHidden
bIsClosing = False
End Sub
A sample file can be found here.
How about using a 'proxy workbook'.
The 'proxy workbook'
is the only workbook which is directly opened by the users
contains the info sheet
contains VBA to open your 'real workbook' using Workbooks.Open (As I've checked with Workbooks.Open documentation by default it will not add the file name to your recent files history unless you set the AddToMru argument to true)
if required the VBA code could even make sure that your 'target workbook' is trusted (I found some sample code here)
The 'target workbook'
contains your Schedule and any other sheets
is only opened if the VBA code in 'proxy workbook' was executed
can be saved by the user at any time as usual
I've got no Office 2007 at hand to test this but think it should do.