|
Tuesday, June 23, 2009 - 9:54 AM
If you've ever developed a complex spreadsheet that was driven at least in part by event macros, you'll see the usefulness of this code immediately. If not, then you may not want to use SubStart and the related subs (yet), but you may still want to use the SetApp and TestApp functions. "SetApp(All,TurnOn)" is an easy way to reset all Excel application settings, for example.
SubStart may be used only in your main procedures (including some event macros), or it may be used in all of your procedures. It's mainly intended for developing Excel applications, but it can also be useful for some types of automation and other complex code. For automation, it's useful for switching back and forth between VBA and the user controlling Excel. It's generally useful for complex projects in that it obviates keeping track of when updating, events, etc. are disabled and enabled, making it faster and easier for you to change your code.
Option Explicit
Option Base 1
Public aStates(), Inputs, States
Public Const Updating = 1, Events = 2, Alerts = 3, Calculation = 4, SetStatusBar = 5, All = "ALL"
Public Const PrimaryCall = True, VBACall = True, TurnOn = True, TurnOff = False
Public Const Manual = xlManual, Automatic = xlAutomatic
Public Function SubStart&(Optional NoUpdating As Boolean, Optional NoEvents As Boolean, Optional NoAlerts As Boolean, _
Optional NoCalculation As Boolean, Optional StatusBarText$, Optional IsPrimaryCall As Boolean)
If Not gvTest Then PopGVs
'requires SetApp, RefreshStates, SubBegin, SubTerminate, TestLen, and myUBound functions
'assumes option base 1; uses aStates, Inputs, and States public arrays (Inputs and States are declared as variants)
'uses Updating (=1), Events (=2), Alerts (=3), Calculation (=4), StatusBar (=5), PrimaryCall (=True),
' TurnOn (=True), TurnOff (=False), Manual (=xlManual), and Automatic (=xlAutomatic) public constants
'calls PopGVs function
'store current states and inputs
Dim n&, i As Byte: States = RefreshStates(StatusBarText)
Inputs = Array(NoUpdating, NoEvents, NoAlerts, NoCalculation, TestLen(StatusBarText), StatusBarText)
'create new location in aStates array
If IsPrimaryCall Then n = 1& Else n = myUBound(aStates, 2) + 1
ReDim Preserve aStates(5, n): SubStart = n 'return n
'store data and make changes (will reset functions if code was interupted)
For i = 1 To 5
If (i < 5) Then aStates(i, n) = States(i) Else aStates(i, n) = States(i + 1)
If (Inputs(i) = States(i)) And (Inputs(i) Or IsPrimaryCall) Then Call SetApp(i, Not Inputs(i), n)
Next
If IsPrimaryCall Then SubBegin (NoUpdating)
End Function
Public Function SubEnd(n&)
'requires SetApp function; assumes option base 1
'uses aStates and States public arrays (States is declared as a variant)
If (n = 1&) Then
'terminate: kill data and reset all functions
Erase aStates: SubTerminate: Call SetApp(All, TurnOn)
Else
'execute
Dim i As Byte: States = RefreshStates
For i = 1 To 5
If States(i) Then Call SetApp(i, TurnOn, n)
Next
End If
End Function
Private Function RefreshStates(Optional StatusBarText$)
With Application
RefreshStates = Array(.ScreenUpdating, .EnableEvents, .DisplayAlerts, (.Calculation = Automatic), True, StatusBarText)
End With
End Function
Private Sub SubBegin(NoUpdating As Boolean)
'put anything here that should run when a primary calling sub begins
' but nothing here should call AddProc, RemoveProc, or SubStart
'this is a separate proc to facilitate stepping through code
If NoUpdating Then ShowTaskPane (Show) 'helps prevent annoying grey bar after code stops (xl '02 bug), but don't show taskpane unless updating is off
Call SetProtection(TurnOff, "Workbook", VBACall)
End Sub
Private Sub SubTerminate()
'put anything here that should run when a primary calling sub ends
' but nothing here should call AddProc, RemoveProc, or SubStart
'this is a separate proc to facilitate stepping through code
ResetColorPalette
Application.CommandBars(1).Visible = True 'worksheet menu bar can get hidden (xl '02 bug)
ShowTaskPane (Hide) 'prevent annoying grey bar after code stops (xl '02 bug)
Call SetProtection(TurnOn, "Workbook")
End Sub
Public Function SetApp(iType, Enable As Boolean, Optional n&)
'uses Updating (=1), Events (=2), Alerts (=3), Calculation (=4), SetStatusBar (=5), PrimaryCall (=True),
' TurnOn (=True), TurnOff (=False), Manual (=xlManual), and Automatic (=xlAutomatic) public constants
'setting status bar is only meant for calls by SubStart and SubEnd functions and requires optional argument n
'example usage: Call SetApp(Updating, TurnOff)
With Application
Select Case iType
Case Updating
.ScreenUpdating = Enable
Case Events
.EnableEvents = Enable
Case Alerts
.DisplayAlerts = Enable
Case Calculation
If Enable Then
If (.Calculation <> Automatic) Then .Calculation = Automatic
Else
If (.Calculation <> Manual) Then .Calculation = Manual: .CalculateBeforeSave = False
End If
Case SetStatusBar
If CBool(n) Then If Not Enable Then .StatusBar = Inputs(6, n) Else .StatusBar = aStates(6, n)
Case All 'all
.ScreenUpdating = Enable: .EnableEvents = Enable: .DisplayAlerts = Enable
If Enable Then
.StatusBar = False
If (.Calculation <> Automatic) Then .Calculation = Automatic
Else
If (.Calculation <> Manual) Then .Calculation = Manual: .CalculateBeforeSave = False
End If
End Select
End With
End Function
Public Function TestApp(iType)
'used TestLen function (see "Basic Functions")
Select Case iType
Case Alerts
TestApp = Application.DisplayAlerts
Case Events
TestApp = Application.EnableEvents
Case Updating
TestApp = Application.ScreenUpdating
Case Calculation
TestApp = (Application.Calculation = Automatic)
Case SetStatusBar
TestApp = Not TestLen(Application.StatusBar) 'returning true means status bar is unset (and free for excel to use)
End Select
End Function
------------------------------------------------------------------------------
'Example usages:
'example usage 1:
Public Sub Main()
Dim subN: subN = SubStart(Updating, Events, Alerts, Calculation, "Starting...", PrimaryCall)
''your code
Call SetApp(Alerts, TurnOn): Call SetApp(Updating, TurnOn)
''some code for which you want alerts and upating on
'' eg, allow user to choose whether and where to save a file your code is closing
Call SetApp(Alerts, aStates(Alerts, subN)): Call SetApp(Updating, aStates(Updating, subN))
'or, for improved speed
If Not aStates(Alerts, subN) Then Call SetApp(Alerts, TurnOff)
If Not aStates(Updating, subN) Then Call SetApp(Updating, TurnOff)
'or simply
Call SetApp(Alerts, TurnOff): Call SetApp(Updating, TurnOff)
''your code
SubEnd (subN)
Exit Sub
ErrHandler:
Call ErrorHandler(Erl, Err)
Resume Next
End Sub
'example usage 2:
Public Sub SomeSubThatCanBeCalledByUserOrVBA(Optional CalledByVBA As Boolean)
Dim subN: subN = SubStart(Updating, Events, Alerts, Calculation, "Processing...", Not CalledByVBA)
''your code
SubEnd (subN)
Exit Sub
ErrHandler:
Call ErrorHandler(Erl, Err)
Resume Next
End Sub
'example usage 3:
Private Sub SomeOtherSub()
Dim subN: subN = SubStart(NoEvents:=True, StatusBar:="Querying database...")
''your code
SubEnd (subN)
Exit Sub
ErrHandler:
Call ErrorHandler(Erl, Err)
Resume Next
End Sub
'example usage 4:
Private Sub SomeOtherSub2()
Dim subN: subN = SubStart(Updating, , , Calculation)
''your code
SubEnd (subN)
Exit Sub
ErrHandler:
Call ErrorHandler(Erl, Err)
Resume Next
End Sub
|