MUtilities

' >>>>>>>>>>>>  MUtilities      <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' Description:  This module contains utility procedures designed
'               to assist the programmer during development.
'
' Authors:      Rob Bovey, www.appspro.com
'               Stephen Bullen, www.oaltd.co.uk
'
' Chapter Change Overview
' Ch#   Comment
' --------------------------------------------------------------
' 05    Initial version
'
Option Explicit
Option Private Module

' **************************************************************
' Module Constant Declarations Follow
' **************************************************************
' We duplicate these constants here because we want this utility
' module to be completely self-contained.
Private Const msFILE_TIME_ENTRY As String = "PetrasTemplate.xls"
Private Const msRNG_NAME_LIST As String = "tblRangeNames"
Private Const msRNG_SHEET_LIST As String = "tblSheetNames"


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comments: This procedure transfers the settings specified in
'           the wksUISettings table into the appropriate
'           worksheets as defined names.
'
'           This procedure cannot be run from outside the
'           add-in. Run it from this module by placing your
'           cursor somewhere inside the body of the procedure
'           and pressing F5. The PetrasTemplate.xlt workbook
'           must be open before this procedure can be run.
'
' Date          Developer       Chap    Action
' --------------------------------------------------------------
' 06/01/08      Rob Bovey       Ch05    Initial version
'
Public Sub WriteSettings()

    Dim rngSheet As Range
    Dim rngSheetList As Range
    Dim rngName As Range
    Dim rngNameList As Range
    Dim rngSetting As Range
    Dim sSheetTab As String
    Dim wkbBook As Workbook
    Dim wksSheet As Worksheet

    ' Turning off screen updating and calculation
    ' will speed the process significantly.
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' The time entry workbook.
    Set wkbBook = Application.Workbooks(msFILE_TIME_ENTRY)
    ' The list of worksheets in the first column.
    Set rngSheetList = wksUISettings.Range(msRNG_SHEET_LIST)
    ' The list of setting names in the first row.
    Set rngNameList = wksUISettings.Range(msRNG_NAME_LIST)

    ' The outer loop processes all the worksheets in the
    ' first column of the table.
    For Each rngSheet In rngSheetList

        ' We need an object reference to the worksheet so we
        ' can easily add a sheet-level defined name to it.
        ' The sSheetTabName() function converts a CodeName
        ' into its corresponding sheet tab name.
        sSheetTab = sSheetTabName(wkbBook, rngSheet.Value)
        Set wksSheet = wkbBook.Worksheets(sSheetTab)

        ' The inner loop adds each setting to the current sheet.
        ' If the setting already exists it will be replaced.
        For Each rngName In rngNameList

            ' The value of the setting is contained in the cell
            ' where the worksheet row and range name column
            ' intersect.
            Set rngSetting = Intersect(rngSheet.EntireRow, _
                                        rngName.EntireColumn)

            ' We only create defined names for settings that
            ' have been given a non-zero-length value.
            If Len(rngSetting.Value) > 0 Then
                wksSheet.Names.Add rngName.Value, _
                            "=" & rngSetting.Value
            End If

        Next rngName

    Next rngSheet

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comments: This procedure removes all the settings specified
'           in the wksUISettings table so that the time entry
'           workbook can be easily maintained.
'
'           This procedure cannot be run from outside the
'           add-in. Run it from this module by placing your
'           cursor somewhere inside the body of the procedure
'           and pressing F5. The PetrasTemplate.xlt workbook
'           must be open before this procedure can be run.
'
' Date          Developer       Chap    Action
' --------------------------------------------------------------
' 06/01/08      Rob Bovey       Ch05    Initial version
'
Public Sub RemoveSettings()

    Dim wkbBook As Workbook
    Dim wksSheet As Worksheet

    ' Turning off screen updating and calculation
    ' will speed the process significantly.
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' The time entry workbook.
    Set wkbBook = Application.Workbooks(msFILE_TIME_ENTRY)

    For Each wksSheet In wkbBook.Worksheets
        wksSheet.Unprotect
        wksSheet.Visible = xlSheetVisible
        wksSheet.Activate
        Application.ActiveWindow.DisplayHeadings = True
        wksSheet.EnableSelection = xlNoRestrictions
        wksSheet.ScrollArea = ""
        With wksSheet.UsedRange
            .EntireColumn.Hidden = False
            .EntireRow.Hidden = False
        End With
    Next wksSheet

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comments: This procedure reads the defined name settings from
'           the user interface worksheets into the wksUISettings
'           table.
'
'           This procedure cannot be run from outside the
'           add-in. You run it from this module by placing
'           your cursor somewhere inside the body of the
'           procedure and pressing F5.
'
' Date          Developer       Chap    Action
' --------------------------------------------------------------
' 06/01/08      Rob Bovey       Ch05    Initial version
'
Public Sub ReadSettings()

    Dim lOffset As Long
    Dim rngName As Range
    Dim rngNameList As Range
    Dim rngSetting As Range
    Dim sMsg As String
    Dim vSetting As Variant
    Dim uAnswer As VbMsgBoxResult
    Dim wkbBook As Workbook
    Dim wksSheet As Worksheet

    ' This process is irreversible. Warn the user before
    ' clearing the existing contents of the table.
    uAnswer = vbNo
    sMsg = "Do you want to overwrite the table with" _
            & vbLf & "the current template settings?"
    uAnswer = MsgBox(sMsg, vbQuestion + vbYesNo)

    If uAnswer = vbYes Then

        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual

        Set wkbBook = Application.Workbooks(msFILE_TIME_ENTRY)

        wksUISettings.UsedRange.Offset(1, 0).Clear

        wkbBook.Activate
        Set rngNameList = wksUISettings.Range(msRNG_NAME_LIST)

        For Each wksSheet In wkbBook.Worksheets

            lOffset = lOffset + 1

            With wksUISettings.Range("A1").Offset(lOffset, 0)

                .Value = wksSheet.CodeName

                For Each rngName In rngNameList

                    Set rngSetting = Intersect(.EntireRow, _
                                        rngName.EntireColumn)

                    ' The setScrollArea setting requires special
                    ' treatment because it's a named range as
                    ' opposed to a named constant.
                    If rngName.Value = "setScrollArea" Then

                        ' This setting may not exist,
                        ' therefore we wrap it in
                        ' On Error Resume Next.
                        On Error Resume Next
                        rngSetting.Value = _
                        wksSheet.Range("setScrollArea").Address
                        On Error GoTo 0

                    Else

                        vSetting = Empty
                        vSetting = Application.Evaluate( _
                            "'" & wksSheet.Name & "'!" & _
                            rngName.Value)

                        If Not IsError(vSetting) Then
                            rngSetting.Value = vSetting
                        End If

                    End If

                Next rngName

            End With

        Next wksSheet

        ThisWorkbook.Activate
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic

    End If

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comments: Obtains the sheet tab name of a worksheet from its
'           code name.
'
' Arguments:    wkbProject      The project workbook to look in.
'               sCodeName       The CodeName of the worksheet whose
'                               sheet tab name you want.
'
' Returns:      String          The sheet tab name corresponding to sCodeName.
'
' Date          Developer       Chap    Action
' --------------------------------------------------------------
' 06/01/08      Rob Bovey       Ch05    Initial version
'
Private Function sSheetTabName(ByRef wkbProject As Workbook, _
                            ByRef sCodeName As String) As String
    Dim wksSheet As Worksheet
    For Each wksSheet In wkbProject.Worksheets
        If wksSheet.CodeName = sCodeName Then
            sSheetTabName = wksSheet.Name
            Exit For
        End If
    Next wksSheet
End Function