I have an excel file that I've enabled users to download, the sheet contains code to enforce the use of macros. But since the users can download the file it appears they are leaving copies open and downloading new versions (since the data is constantly updated).
I believe the VBA in the file is causing issues with the copies of itself as when I attempt to close one (While I have two open) Excel will crash.
I looked through the code and made sure to reference ThisWorkbook wherever possible, but I don't have much experience with VBA.
The below code is all the VBA in the file, and is all located in the 'ThisWorkbook'
Any help locating the reason for the crash is much appreciated.
I believe the VBA in the file is causing issues with the copies of itself as when I attempt to close one (While I have two open) Excel will crash.
I looked through the code and made sure to reference ThisWorkbook wherever possible, but I don't have much experience with VBA.
The below code is all the VBA in the file, and is all located in the 'ThisWorkbook'
Any help locating the reason for the crash is much appreciated.
Code:
Option Explicit
Const WelcomePage = "Alert"
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim answer As VbMsgBoxResult
If Application.Calculation = xlCalculationAutomatic Then
If ThisWorkbook.Saved = False Then
Application.Calculation = xlCalculationManual
answer = MsgBox("Do you want to save the changes you made to " & ThisWorkbook.Name & "?", vbYesNoCancel)
If answer = vbYes Then
Call HideAllSheets
ThisWorkbook.Close True
ElseIf answer = vbNo Then
ThisWorkbook.Close False
ElseIf answer = vbCancel Then
Application.Calculation = xlCalculationAutomatic
Cancel = True
End If
End If
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Application.Calculation = xlCalculationAutomatic Then
Dim ws As Worksheet
Dim wsActive As Worksheet
Dim vFilename As Variant
Dim bSaved As Boolean
'Turn off screen flashing
With Application
.EnableEvents = False
.ScreenUpdating = False
.DisplayAlerts = False
End With
'Record active worksheet
Set wsActive = ThisWorkbook.ActiveSheet
On Error GoTo Reset
'Save workbook directly or prompt for saveas filename
If SaveAsUI = True Then
vFilename = Application.GetSaveAsFilename( _
fileFilter:="Excel Macro-Enabled Workbook(*.xlsm), *.xlsm")
If CStr(vFilename) = "False" Then
bSaved = False
Else
'Save the workbook using the supplied filename
Call HideAllSheets
ThisWorkbook.SaveAs vFilename
Application.RecentFiles.Add vFilename
Call ShowAllSheets
bSaved = True
End If
Else
'Save the workbook
Call HideAllSheets
ThisWorkbook.Save
Call ShowAllSheets
bSaved = True
End If
'Restore file to where user was
wsActive.Activate
Reset:
'Restore screen updates
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
On Error GoTo 0
'Set application states appropriately
If bSaved Then
ThisWorkbook.Saved = True
Cancel = True
Else
Cancel = True
End If
End If
End Sub
Private Sub Workbook_Open()
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True
ThisWorkbook.Saved = True
Dim w As Worksheet, p As PivotTable
For Each w In ThisWorkbook.Worksheets
For Each p In w.PivotTables
p.RefreshTable
p.Update
Next
Next
End Sub
Private Sub HideAllSheets()
Dim ws As Worksheet
ThisWorkbook.Worksheets(WelcomePage).Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws
ThisWorkbook.Worksheets(WelcomePage).Activate
End Sub
Private Sub ShowAllSheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
Next ws
ThisWorkbook.Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub