Procedure Wrapper

This is a generalised procedure wrapper you can use in your work. It's not supposed to cover all eventualities but could be used as an aide-memoir.

What it does

There are three parts to the code.

• The first section captures the current calculation mode, changes the present mode to manual, reports a message to the status bar and turns off screen updating. It also remembers the cell in which we started and tests for the sheet's protection setting. If the sheet is password protected, the procedure stops.
• After your code has executed it returns the calculation mode to your original setting, clears the status bar and turns the screen back on. It also returns your cursor to the start position and resets the worksheet's protection setting.
  This part of the code is also executed if the third part of the code, the error capture, is initiated.

You might need to put a ".Calculation" within your own code to over-ride the manual setting.

Turning the screen back on might not be appropriate depending on what other code is in operation.

Please ..

Please let me know if it's useful, or what changes or amendments you think could be made.

''***************************************************************************
'' Purpose  : Description 
'' Written  : dd-mmm-yyyy by Andy Wiggins, BygSoftware.com 
''
Sub ProcNameGoesHere()
Dim lVar_CalcVal As Variant
Dim lBoo_ScreenUpdating As Boolean
Dim lStr_StatusBar As String
Dim lStr_StartCell As String
Dim lLng_SheetProtection As Long

Const cStr_MsgBoxTitle = "BygSoftware.com"

On Error GoTo Err_CurProc

    With Application
        '' Capture the current settings
        lVar_CalcVal = .Calculation
        .Calculation = xlCalculationManual

        lStr_StatusBar = .StatusBar
        .StatusBar = ".. inserting and copying a row"

        lBoo_ScreenUpdating = .ScreenUpdating
        .ScreenUpdating = False
    End With

    '' Remember where we are
    lStr_StartCell = ActiveCell.Address

    '' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    '' Deal with protection / Unprotect the sheet
    '' Capture current protection state
    lLng_SheetProtection = SheetProtectState

    Select Case lLng_SheetProtection
        Case 0
            MsgBox "Sheet is password protected - can't continue", vbCritical + vbOKOnly, "BygSoftware.com"
            'End
            Resume Exit_CurProc
        Case 1
            '' Nothing to do
        Case 2
            ActiveSheet.Unprotect
    End Select

    ''##
    '' Code goes here
    ''##

Exit_CurProc:

    '' Reset the protection
    Select Case lLng_SheetProtection
        Case 2
            ActiveSheet.Protect
    End Select

    '' Go back to where we started
    Range(lStr_StartCell).Select

    With Application
        .CutCopyMode = False
        .Calculation = lVar_CalcVal
        .StatusBar = IIf(UCase(lStr_StatusBar) = "FALSE", False, lStr_StatusBar)
        .ScreenUpdating = lBoo_ScreenUpdating
    End With

    Exit Sub

Err_CurProc:
Dim lStr_ErrMsg As String

    lStr_ErrMsg = ""
    lStr_ErrMsg = lStr_ErrMsg & "Error: " & vbCrLf & vbCrLf
    lStr_ErrMsg = lStr_ErrMsg & "Please report this error to ..." & vbCrLf
    lStr_ErrMsg = lStr_ErrMsg & "Error number: " & Err
    lStr_ErrMsg = lStr_ErrMsg & Error(Err)

    '' Do error things here
    MsgBox lStr_ErrMsg, vbOKOnly + vbCritical, cStr_MsgBoxTitle
    Resume Exit_CurProc

End Sub

''**************************************************************
'' Purpose  : Check if a worksheet is locked - NUMERIC 
'' Written  : 25-Nov-1996 by Andy Wiggins - BygSoftware.com 
''
Function SheetProtectState() As Long ''Numeric result 
Dim lVar_UnprotectResult 
Dim lLng_Result

On Error Resume Next

    ''Need a false password to stop messages : 25-Sep-1998 Use an empty string of no length
    lVar_UnprotectResult = ActiveSheet.Unprotect(password:="")

    Select Case VarType(lVar_UnprotectResult)
        Case 0
            lLng_Result = 0     ''Password protected
        Case 1
            lLng_Result = 1     ''Unprotected
        Case 11
            lLng_Result = 2     ''Protected
            ActiveSheet.Protect
        Case Else
            lLng_Result = 3     ''Anything else
    End Select

    SheetProtectState = lLng_Result

End Function

-

Published: 17-Jun-2004
Last edited: 05-Jun-2005 19:28