' ========================================================================================================================
' ____,__, __, ____,_, _, ____ ____,__, ,____,____,
' (-/_|(-| (-| (-|_,(-|\ | (-|__|-/_|( |_/(-|_,(-|__)
' _/ |,_|__,_|__,_|__,_| \|, _|__)/ |,_| \,_|__,_| \,
'
' Copyright 2011 Allen Baker
'
' ------------------------------------------------------------------------------------------------------------------------
' File: M025_Config
' Originator: Allen Baker (2011.01.22 23:08)
' ------------------------------------------------------------------------------------------------------------------------
' $RCSfile$
' $Revision$
' $Date$
' ========================================================================================================================
'
Option Explicit
' ========================================================================================================================
' Description
' This module retrieves configuration parameter values from the config sheet in the current Excel workbook.
' ========================================================================================================================
' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[ Constants ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================
' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[ Module Variables ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================
' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[ Public Routines ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine reads a string configuration parameter value from the config sheet and if the parameter
' value is missing, it does an error exit from the program.
'
' param
' pValue is the value that is read from the config sheet and it is returned through the parameter to the
' caller.
' param
' pParameter is the name of the parameter for which a value is read.
' param
' pMissingValue is an optional parameter that provides a value that will be interpreted as meaning that
' the parameter
' value is missing. If the pValue is equal to pMissingValue after an attempt is made to read it from the
' config sheet
' then pValue will be deemed missing and an error exit will be executed.
' -----------------------------------------------------------------------------------------------------------
Public Sub mustGetStringParameterValue(ByRef pValue As String, pParameter As String, Optional pMissingValue As String = "")
pValue = stringParameter(pParameter)
Call ifStringParameterMissingErrorExit(pValue, pParameter, pMissingValue)
End Sub
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine reads a double configuration parameter value from the config sheet and if the parameter
' value is missing, it does an error exit from the program.
'
' param
' pValue is the value that is read from the config sheet and it is returned through the parameter to the
' caller.
' param
' pParameter is the name of the parameter for which a value is read.
' param
' pMissingValue is an optional parameter that provides a value that will be interpreted as meaning that
' the parameter value is missing. If the pValue is equal to pMissingValue after an attempt is made to
' read it from the config sheet then pValue will be deemed missing and an error exit will be executed.
' -----------------------------------------------------------------------------------------------------------
Public Sub mustGetDoubleParameterValue(ByRef pValue As Double, pParameter As String, Optional pMissingValue As Double = 0#)
pValue = doubleParameter(pParameter)
Call ifDoubleParameterMissingErrorExit(pValue, pParameter, pMissingValue)
End Sub
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the value of the parameter that has the same name as this function.
'
' return
' this function returns the value of the parameter that has the same name as this function.
' -----------------------------------------------------------------------------------------------------------
Public Function myVacationTab() As String
Static cMyVacationTab As String
cMyVacationTab = stringParameter("myVacationTab", cMyVacationTab)
myVacationTab = cMyVacationTab
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the value of the parameter that has the same name as this function.
'
' return
' this function returns the value of the parameter that has the same name as this function.
' -----------------------------------------------------------------------------------------------------------
Public Function myVacationFile() As String
Static cMyVacationFile As String
cMyVacationFile = stringParameter("myVacationFile", cMyVacationFile)
myVacationFile = cMyVacationFile
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the value of the parameter that has the same name as this function.
'
' return
' this function returns the value of the parameter that has the same name as this function.
' -----------------------------------------------------------------------------------------------------------
Public Function usHolidaysTab() As String
Static cUsHolidaysTab As String
cUsHolidaysTab = stringParameter("usHolidaysTab", cUsHolidaysTab)
usHolidaysTab = cUsHolidaysTab
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the value of the parameter that has the same name as this function.
'
' return
' this function returns the value of the parameter that has the same name as this function.
' -----------------------------------------------------------------------------------------------------------
Public Function usHolidaysFile() As String
Static cUsHolidaysFile As String
cUsHolidaysFile = stringParameter("usHolidaysFile", cUsHolidaysFile)
usHolidaysFile = cUsHolidaysFile
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the value of the parameter that has the same name as this function.
'
' return
' this function returns the value of the parameter that has the same name as this function.
' -----------------------------------------------------------------------------------------------------------
Public Function bloreHolidaysTab() As String
Static cBloreHolidaysTab As String
cBloreHolidaysTab = stringParameter("bloreHolidaysTab", cBloreHolidaysTab)
bloreHolidaysTab = cBloreHolidaysTab
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the value of the parameter that has the same name as this function.
'
' return
' this function returns the value of the parameter that has the same name as this function.
' -----------------------------------------------------------------------------------------------------------
Public Function bloreHolidaysFile() As String
Static cBloreHolidaysFile As String
cBloreHolidaysFile = stringParameter("bloreHolidaysFile", cBloreHolidaysFile)
bloreHolidaysFile = cBloreHolidaysFile
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the value of the parameter that has the same name as this function.
'
' return
' this function returns the value of the parameter that has the same name as this function.
' -----------------------------------------------------------------------------------------------------------
Public Function holidayClosuresTab() As String
Static cHolidayClosuresTab As String
cHolidayClosuresTab = stringParameter("holidayClosuresTab", cHolidayClosuresTab)
holidayClosuresTab = cHolidayClosuresTab
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the value of the parameter that has the same name as this function.
'
' return
' this function returns the value of the parameter that has the same name as this function.
' -----------------------------------------------------------------------------------------------------------
Public Function holidayClosuresFile() As String
Static cHolidayClosuresFile As String
cHolidayClosuresFile = stringParameter("holidayClosuresFile", cHolidayClosuresFile)
holidayClosuresFile = cHolidayClosuresFile
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' If pCurrentValue is the empty string, this function retrieves the value of the specified parameter from
' the config sheet. If pCurrValue is not the empty string, this function simply returns pCurrValue.
'
' pCurrValue is a performance enhancement and is used the way it is to support retrieving a configuration
' parameter value one time only. A configuration parameter value is retrieved only one time if:
' 1) the argument passed in through the pCurrValue parameter is a persistent (static or module) variable
' and
'
' 2) the value returned from this function is assigned to that persistent variable in the calling
' routine
'
' For example:
'
' Dim persist As String ' the initial value of persist is ""
' '
' ' ==============================================================================================
' ' The first time persistValue() is called, persist equals "". Accordingly, stringParameter()
' ' locates the config sheet, looks-up the "configParam" parameter on that sheet, and returns its
' ' value to persistValue(). Assume the value is "tuna". The next time persistValue() is called,
' ' persist no longer equals "", it equals "tuna". Consequently stringParameter() just returns
' ' persist's value of "tuna" without looking again for the value of the "configParam" parameter
' ' on the config sheet.
' ' ----------------------------------------------------------------------------------------------
' Function persistValue() As String
' persist = stringParameter("configParam", persist)
' persistValue = persist
' End Function
'
' return
' this function returns the value of the specified parameter from the config sheet or pCurrValue
'
' param
' pParameter is the name of the parameter to return the value of
' param (optional)
' pCurrValue is the current value of the static variable in which the value of the specified parameter is
' being kept.
' param (optional)
' pOccurrence identifies which instance of this parameter in the config sheet to retrieve or set. This
' parameter makes it possible to have the same parameter defeined multiple times.
' -----------------------------------------------------------------------------------------------------------
Public Function stringParameter(pParameter As String, Optional pCurrValue As String = "", Optional pOccurrence As Long = 1) As String
Select Case configVersion()
Case 2#, 2.01, 3#, 3.01, 4#
stringParameter = stringParameter0200(pParameter, pCurrValue, pOccurrence)
Case Else
stringParameter = stringParameter0000(pParameter, pCurrValue, pOccurrence)
End Select
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Public Sub setStringParameter(pParameter As String, pCurrValue As String, Optional pOccurrence As Long = 1)
Select Case configVersion()
Case 2#, 2.01, 3#, 3.01, 4#
Call setStringParameter0200(pParameter, pCurrValue, pOccurrence)
Case Else
Call setStringParameter0000(pParameter, pCurrValue, pOccurrence)
End Select
End Sub
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Public Function doubleParameter(pParameter As String, Optional pCurrValue As Double = 0#, Optional pOccurrence As Long = 1) As Double
Select Case configVersion()
Case 2#, 2.01, 3#, 3.01, 4#
doubleParameter = doubleParameter0200(pParameter, pCurrValue, pOccurrence)
Case Else
doubleParameter = doubleParameter0000(pParameter, pCurrValue, pOccurrence)
End Select
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Public Sub setDoubleParameter(pParameter As String, pCurrValue As Double, Optional pOccurrence As Long = 1)
Select Case configVersion()
Case 2#, 2.01, 3#, 3.01, 4#
Call setDoubleParameter0200(pParameter, pCurrValue, pOccurrence)
Case Else
Call setDoubleParameter0000(pParameter, pCurrValue, pOccurrence)
End Select
End Sub
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Public Function dateParameter(pParameter As String, Optional pCurrValue As Date = #1/1/1993#, Optional pOccurrence As Long = 1) As Date
Select Case configVersion()
Case 2#, 2.01, 3#, 3.01, 4#
dateParameter = dateParameter0200(pParameter, pCurrValue, pOccurrence)
Case Else
dateParameter = dateParameter0000(pParameter, pCurrValue, pOccurrence)
End Select
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Public Sub setDateParameter(pParameter As String, pCurrValue As Date, Optional pOccurrence As Long = 1)
Select Case configVersion()
Case 2#, 2.01, 3#, 3.01, 4#
Call setDateParameter0200(pParameter, pCurrValue, pOccurrence)
Case Else
Call setDateParameter0000(pParameter, pCurrValue, pOccurrence)
End Select
End Sub
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine assigns each cell in the range A1:A100 a fill color and font color. The colors it chooses
' are based on the fill color in the cell A1. It uses the fill color in the starting label color cell as
' the fill color for the first label cell. It then calculates the most clockwise spit complement (at about
' 198 degrees offset) and uses that as the next label's fill color. It continues this process around the
' color wheel till all the labels have a color assigned
' -----------------------------------------------------------------------------------------------------------
Public Sub generateColorPaletteOnConfigSheet()
If worksheetExists("config") Then
With Worksheets("config")
Select Case configVersion()
Case 2#, 2.01, 3#, 3.01, 4#
Call generateColorPaletteInSpecifiedRange(.Range("ColorPaletteStartColor"), .Range("ColorPaletteCells"), .Range("ColorPaletteLightnessDelta"), .Range("ColorPaletteSplitComplimentDelta"))
Case Else
Call generateColorPaletteInSpecifiedRange(.Range("D2"), .Range("D4:D101"), .Range("J6"), .Range("J7"))
End Select
End With
End If
End Sub
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the row number for the first cell in the color palette's fill color cells
'
' return
' This function returns the row number for the first cell in the color palette's fill color cells
' -----------------------------------------------------------------------------------------------------------
Public Function firstColorPaletteRow() As Long
firstColorPaletteRow = 0
Select Case configVersion()
Case 2#, 2.01, 3#, 3.01, 4#
If worksheetExists("config") Then
firstColorPaletteRow = Worksheets("config").Range("ColorPaletteCells").Row
End If
Case Else
If worksheetExists("config") Then
firstColorPaletteRow = 4
End If
End Select
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the column number for the first cell in the color palette's fill color cells
'
' return
' This function returns the column number for the first cell in the color palette's fill color cells
' -----------------------------------------------------------------------------------------------------------
Public Function firstColorPaletteColumn() As Long
firstColorPaletteColumn = 0
Select Case configVersion()
Case 2#, 2.01, 3#, 3.01, 4#
If worksheetExists("config") Then
firstColorPaletteColumn = Worksheets("config").Range("ColorPaletteCells").Column
End If
Case Else
If worksheetExists("config") Then
firstColorPaletteColumn = 4
End If
End Select
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the version number of the config sheet in the active workbook
'
' return
' This function returns the version number of the config sheet
' -----------------------------------------------------------------------------------------------------------
Public Function configVersion() As Double
configVersion = 0#
If (namedRangeExistsInActiveWorkbook("ConfigVersion")) Then
configVersion = Val(Range("ConfigVersion").Cells(1, 1).value)
End If
End Function
' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[ Private Routines ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine tests a parameter value and if it is "", then calls an errorExit
'
' param
' pValue is the value that is read from the config sheet and it is returned through the parameter to the
' caller.
' param
' pParameter is the name of the parameter for which a value is read.
' param
' pMissingValue is an optional parameter that provides a value that will be interpreted as meaning that
' the parameter value is missing. If the pValue is equal to pMissingValue after an attempt is made to
' read it from the config sheet then pValue will be deemed missing and an error exit will be executed.
' -----------------------------------------------------------------------------------------------------------
Private Sub ifStringParameterMissingErrorExit(pValue As String, pParameter As String, Optional pMissingValue As String = "")
If (pValue = pMissingValue) Then
Call errorExit("E004 Parameter Value Missing Error - Cannot find config parameter value for " & pParameter)
End If
End Sub
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine tests a parameter value and if it is zero, then calls an errorExit
'
' param
' pValue is the value that is read from the config sheet and it is returned through the parameter to the
' caller.
' param
' pParameter is the name of the parameter for which a value is read.
' param
' pMissingValue is an optional parameter that provides a value that will be interpreted as meaning that
' the parameter value is missing. If the pValue is equal to pMissingValue after an attempt is made to
' read it from the config sheet then pValue will be deemed missing and an error exit will be executed.
' -----------------------------------------------------------------------------------------------------------
Private Sub ifDoubleParameterMissingErrorExit(pValue As Double, pParameter As String, Optional pMissingValue As Double = 0#)
If (pValue = pMissingValue) Then
Call errorExit("E004 Parameter Value Missing Error - Cannot find config parameter value for " & pParameter)
End If
End Sub
' =====================================================================================================================
' ����������������������������������������[ Routines For Version 0000 ]����������������������������������������
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine assigns each cell in a range - pCellsToColor - a fill color and font color. The colors it
' chooses are based on the fill color in the "Starting Label Color" cell - pStartColorCell. It uses the
' fill color in the starting label color cell as the fill color for the first label cell. It then
' calculates the most clockwise spit complement (at about 198 degrees offset) and uses that as the next
' label's fill color. It continues this process around the color wheel till all the labels have a color
' assigned
' -----------------------------------------------------------------------------------------------------------
Private Sub generateColorPaletteInSpecifiedRange(pStartColorCell As Range, pCellsToColor As Range, pLightnessDelta As Range, pSplitComplimentDelta As Range)
'
' ==============================================================================================
' = 15.00000000000000000000000000 256-ths ??? 14 = a 19.69 degree split complement delta,
' taking 18.29 deltas to circumvent the color circle
' ----------------------------------------------------------------------------------------------
' Const SPLIT_COMPLEMENT_DELTA = 14#
Dim splitComplementDelta As Double
'
' ==============================================================================================
' a place to store the HSL components as Longs
' ----------------------------------------------------------------------------------------------
Dim lH As Long
Dim lS As Long
Dim lL As Long
'
' ==============================================================================================
' a place to store the HSL components as Doubles (for precision calculations)
' ----------------------------------------------------------------------------------------------
Dim dH As Double
Dim dHc As Double
Dim dS As Double
Dim dL As Double
Dim dLl As Double
'
' ==============================================================================================
' other vars
' ----------------------------------------------------------------------------------------------
Dim currentCell As Range
Dim complementCell As Range
Dim hsl As Long
Dim rowIdx As Long
Dim lightnessDelta As Double
'
' ==============================================================================================
' get the HSL components of the starting color as Longs and create Double versions of each
' component
' ----------------------------------------------------------------------------------------------
hsl = rgbToHsl(pStartColorCell.Cells(1, 1).Interior.Color, lH, lS, lL)
dH = CDbl(lH)
dHc = fmod(Abs(dH + 128#), 256#)
dS = CDbl(lS)
dL = CDbl(lL)
lightnessDelta = pLightnessDelta.Cells(1, 1).value
splitComplementDelta = pSplitComplimentDelta.Cells(1, 1).value
'
' ==============================================================================================
' for each cell in the column of labels, compute and assign a fill color and a contrasting font
' color.
' 2014.04.02: changed to BW font color because using so many font/color combinations
' apparently uses up the max number of fonts in Excel.
' ----------------------------------------------------------------------------------------------
For rowIdx = 1 To pCellsToColor.rows.count
'
' ==============================================================================================
' set color in first column
' ----------------------------------------------------------------------------------------------
Set currentCell = pCellsToColor.Cells(rowIdx, 1)
currentCell.Interior.Color = hslToRgb(dH, dS, dL)
' currentCell.Font.Color = bestRgbFontColor(dH, dS, dL)
currentCell.Font.Color = bestRgbFontBlackOrWhite(currentCell.Interior.Color)
currentCell.Font.fontStyle = "Bold"
If rowIdx = 1 Then
pStartColorCell.Font.Color = bestRgbFontColor(dH, dS, dL)
pStartColorCell.Font.fontStyle = "Bold"
End If
'
' ==============================================================================================
' set light color in second column
' ----------------------------------------------------------------------------------------------
dLl = min(245, (dL + lightnessDelta))
Set currentCell = pCellsToColor.Cells(rowIdx, 2)
currentCell.Interior.Color = hslToRgb(dH, dS, dLl)
' currentCell.Font.Color = bestRgbFontColor(dH, dS, dLl)
currentCell.Font.Color = bestRgbFontBlackOrWhite(currentCell.Interior.Color)
currentCell.Font.fontStyle = "Bold"
'
' ==============================================================================================
' set complement color in third column
' ----------------------------------------------------------------------------------------------
Set currentCell = pCellsToColor.Cells(rowIdx, 3)
currentCell.Interior.Color = hslToRgb(dHc, dS, dL)
' currentCell.Font.Color = bestRgbFontColor(dHc, dS, dL)
currentCell.Font.Color = bestRgbFontBlackOrWhite(currentCell.Interior.Color)
currentCell.Font.fontStyle = "Bold"
'
' ==============================================================================================
' set light complement color in fourth column
' ----------------------------------------------------------------------------------------------
Set currentCell = pCellsToColor.Cells(rowIdx, 4)
currentCell.Interior.Color = hslToRgb(dHc, dS, dLl)
' currentCell.Font.Color = bestRgbFontColor(dHc, dS, dLl)
currentCell.Font.Color = bestRgbFontBlackOrWhite(currentCell.Interior.Color)
currentCell.Font.fontStyle = "Bold"
'
' ==============================================================================================
' increment the hue
' ----------------------------------------------------------------------------------------------
dH = fmod(Abs(dH + 128# + splitComplementDelta), 256#)
dHc = fmod(Abs(dH + 128#), 256#)
Next rowIdx
End Sub
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' If pCurrentValue is the empty string, this function retrieves the value of the specified parameter from
' the config sheet. If pCurrValue is not the empty string, this function simply returns pCurrValue.
'
' pCurrValue is a performance enhancement and is used the way it is to support retrieving a configuration
' parameter value one time only. A configuration parameter value is retrieved only one time if:
' 1) the argument passed in through the pCurrValue parameter is a persistent (static or module) variable
' and 2) the value returned from this function is assigned to that persistent variable in the calling
' routine
'
' For example:
'
' Dim persist As String ' the initial value of persist is ""
' '
' ' ==============================================================================================
' ' The first time persistValue() is called, persist equals "". Accordingly,
' ' stringParameter0000() locates the config sheet, looks-up the "configParam" parameter on that
' ' sheet, and returns its value to persistValue(). Assume the value is "tuna". The next time
' ' persistValue() is called, persist no longer equals "", it equals "tuna". Consequently
' ' stringParameter0000() just returns persist's value of "tuna" without looking again for the
' ' value of the "configParam" parameter on the config sheet.
' ' ----------------------------------------------------------------------------------------------
' Function persistValue() As String
' persist = stringParameter0000("configParam", persist)
' persistValue = persist
' End Function
'
' return
' this function returns the value of the specified parameter from the config sheet or pCurrValue
'
' param
' pParameter is the name of the parameter to return the value of
' param (optional)
' pCurrValue is the current value of the static variable in which the value of the specified parameter is
' being kept.
' param (optional)
' pOccurrence identifies which instance of this parameter in the config sheet to retrieve or set. This
' parameter makes it possible to have the same parameter defeined multiple times.
' -----------------------------------------------------------------------------------------------------------
Private Function stringParameter0000(pParameter As String, Optional pCurrValue As String = "", Optional pOccurrence As Long = 1) As String
Dim occurrence As Long
occurrence = 0
stringParameter0000 = pCurrValue
pParameter = UCase(pParameter)
'
' ==============================================================================================
' we use static variables so that we only go through this one time for a given parameter. If
' the static variable is in an initialized state (0 or ""), then we look for the config sheet.
' Upon finding it, we look for the parameter and if it's found, we return its value. If the
' config sheet or the parameter is not found, then we return the initial state value.
' ----------------------------------------------------------------------------------------------
If pCurrValue = "" Then
Dim parameterRange As Range
If worksheetExists("config") Then
Dim rowIdx As Long
Set parameterRange = Worksheets("config").Range("$A$2:$B$201")
For rowIdx = 1 To parameterRange.rows.count
If (UCase(parameterRange(rowIdx, 1).value) = pParameter) Then
occurrence = occurrence + 1
If (occurrence = pOccurrence) Then
stringParameter0000 = parameterRange(rowIdx, 2)
Exit For
End If
End If
Next rowIdx
End If
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Private Sub setStringParameter0000(pParameter As String, pCurrValue As String, Optional pOccurrence As Long = 1)
Dim occurrence As Long
occurrence = 0
pParameter = UCase(pParameter)
Dim parameterRange As Range
If worksheetExists("config") Then
Dim rowIdx As Long
Set parameterRange = Worksheets("config").Range("$A$2:$B$201")
For rowIdx = 1 To parameterRange.rows.count
If (UCase(parameterRange(rowIdx, 1).value) = pParameter) Then
occurrence = occurrence + 1
If (occurrence = pOccurrence) Then
parameterRange(rowIdx, 2).value = pCurrValue
Exit For
End If
End If
Next rowIdx
End If
End Sub
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Private Function doubleParameter0000(pParameter As String, Optional pCurrValue As Double = 0#, Optional pOccurrence As Long = 1) As Double
Dim occurrence As Long
occurrence = 0
doubleParameter0000 = pCurrValue
pParameter = UCase(pParameter)
'
' ==============================================================================================
' we use static variables so that we only go through this one time for a given parameter. If
' the static variable is in an initialized state (0 or ""), then we look for the config sheet.
' Upon finding it, we look for the parameter and if it's found, we return its value. If the
' config sheet or the parameter is not found, then we return the initial state value.
' ----------------------------------------------------------------------------------------------
If pCurrValue = 0# Then
Dim parameterRange As Range
If worksheetExists("config") Then
Dim rowIdx As Long
Set parameterRange = Worksheets("config").Range("$A$2:$B$201")
For rowIdx = 1 To parameterRange.rows.count
If (UCase(parameterRange(rowIdx, 1).value) = pParameter) Then
occurrence = occurrence + 1
If (occurrence = pOccurrence) Then
doubleParameter0000 = Val(parameterRange(rowIdx, 2).value)
Exit For
End If
End If
Next rowIdx
End If
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Private Sub setDoubleParameter0000(pParameter As String, pCurrValue As Double, Optional pOccurrence As Long = 1)
Dim occurrence As Long
occurrence = 0
pParameter = UCase(pParameter)
Dim parameterRange As Range
If worksheetExists("config") Then
Dim rowIdx As Long
Set parameterRange = Worksheets("config").Range("$A$2:$B$201")
For rowIdx = 1 To parameterRange.rows.count
If (UCase(parameterRange(rowIdx, 1).value) = pParameter) Then
occurrence = occurrence + 1
If (occurrence = pOccurrence) Then
parameterRange(rowIdx, 2).value = pCurrValue
Exit For
End If
End If
Next rowIdx
End If
End Sub
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Private Function dateParameter0000(pParameter As String, Optional pCurrValue As Date = #1/1/1993#, Optional pOccurrence As Long = 1) As Date
Dim occurrence As Long
occurrence = 0
dateParameter0000 = pCurrValue
pParameter = UCase(pParameter)
'
' ==============================================================================================
' we use static variables so that we only go through this one time for a given parameter. If
' the static variable is in an initialized state (0 or ""), then we look for the config sheet.
' Upon finding it, we look for the parameter and if it's found, we return its value. If the
' config sheet or the parameter is not found, then we return the initial state value.
' ----------------------------------------------------------------------------------------------
If pCurrValue = #1/1/1993# Then
Dim parameterRange As Range
If worksheetExists("config") Then
Dim rowIdx As Long
Set parameterRange = Worksheets("config").Range("$A$2:$B$201")
For rowIdx = 1 To parameterRange.rows.count
If (UCase(parameterRange(rowIdx, 1).value) = pParameter) Then
occurrence = occurrence + 1
If (occurrence = pOccurrence) Then
dateParameter0000 = DateValue(parameterRange(rowIdx, 2).value)
Exit For
End If
End If
Next rowIdx
End If
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Private Sub setDateParameter0000(pParameter As String, pCurrValue As Date, Optional pOccurrence As Long = 1)
Dim occurrence As Long
occurrence = 0
pParameter = UCase(pParameter)
Dim parameterRange As Range
If worksheetExists("config") Then
Dim rowIdx As Long
Set parameterRange = Worksheets("config").Range("$A$2:$B$201")
For rowIdx = 1 To parameterRange.rows.count
If (UCase(parameterRange(rowIdx, 1).value) = pParameter) Then
occurrence = occurrence + 1
If (occurrence = pOccurrence) Then
parameterRange(rowIdx, 2).value = pCurrValue
Exit For
End If
End If
Next rowIdx
End If
End Sub
' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[ Routines For Version 0200 ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' If pCurrentValue is the empty string, this function retrieves the value of the specified parameter from
' the config sheet. If pCurrValue is not the empty string, this function simply returns pCurrValue.
'
' pCurrValue is a performance enhancement and is used the way it is to support retrieving a configuration
' parameter value one time only. A configuration parameter value is retrieved only one time if:
' 1) the argument passed in through the pCurrValue parameter is a persistent (static or module) variable
' and 2) the value returned from this function is assigned to that persistent variable in the calling
' routine
'
' For example:
'
' Dim persist As String ' the initial value of persist is ""
' ' ==============================================================================================
' ' The first time persistValue() is called, persist equals "". Accordingly,
' ' stringParameter0200() locates the config sheet, looks-up the "configParam" parameter on that
' ' sheet, and returns its value to persistValue(). Assume the value is "tuna". The next time
' ' persistValue() is called, persist no longer equals "", it equals "tuna". Consequently
' ' stringParameter0200() just returns persist's value of "tuna" without looking again for the
' ' value of the "configParam" parameter on the config sheet.
' ' ----------------------------------------------------------------------------------------------
' Function persistValue() As String
' persist = stringParameter0200("configParam", persist)
' persistValue = persist
' End Function
'
' return
' this function returns the value of the specified parameter from the config sheet or pCurrValue
'
' param
' pParameter is the name of the parameter to return the value of
' param (optional)
' pCurrValue is the current value of the static variable in which the value of the specified parameter is
' being kept.
' param (optional)
' pOccurrence identifies which instance of this parameter in the config sheet to retrieve or set. This
' parameter makes it possible to have the same parameter defeined multiple times.
' -----------------------------------------------------------------------------------------------------------
Private Function stringParameter0200(pParameter As String, Optional pCurrValue As String = "", Optional pOccurrence As Long = 1) As String
Dim occurrence As Long
occurrence = 0
stringParameter0200 = pCurrValue
pParameter = UCase(pParameter)
'
' ==============================================================================================
' we use static variables so that we only go through this one time for a given parameter. If
' the static variable is in an initialized state (0 or ""), then we look for the config sheet.
' Upon finding it, we look for the parameter and if it's found, we return its value. If the
' config sheet or the parameter is not found, then we return the initial state value.
' ----------------------------------------------------------------------------------------------
If pCurrValue = "" Then
Dim parameterRange As Range
If worksheetExists("config") Then
Dim rowIdx As Long
Set parameterRange = Worksheets("config").Range("ConfigParameters")
For rowIdx = 1 To parameterRange.rows.count
If (UCase(parameterRange(rowIdx, 1).value) = pParameter) Then
occurrence = occurrence + 1
If (occurrence = pOccurrence) Then
stringParameter0200 = parameterRange(rowIdx, 2)
Exit For
End If
End If
Next rowIdx
End If
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Private Sub setStringParameter0200(pParameter As String, pCurrValue As String, Optional pOccurrence As Long = 1)
Dim occurrence As Long
occurrence = 0
pParameter = UCase(pParameter)
Dim parameterRange As Range
If worksheetExists("config") Then
Dim rowIdx As Long
Set parameterRange = Worksheets("config").Range("ConfigParameters")
For rowIdx = 1 To parameterRange.rows.count
If (UCase(parameterRange(rowIdx, 1).value) = pParameter) Then
occurrence = occurrence + 1
If (occurrence = pOccurrence) Then
parameterRange(rowIdx, 2).value = pCurrValue
Exit For
End If
End If
Next rowIdx
End If
End Sub
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Private Function doubleParameter0200(pParameter As String, Optional pCurrValue As Double = 0#, Optional pOccurrence As Long = 1) As Double
Dim occurrence As Long
occurrence = 0
doubleParameter0200 = pCurrValue
pParameter = UCase(pParameter)
'
' ==============================================================================================
' we use static variables so that we only go through this one time for a given parameter. If
' the static variable is in an initialized state (0 or ""), then we look for the config sheet.
' Upon finding it, we look for the parameter and if it's found, we return its value. If the
' config sheet or the parameter is not found, then we return the initial state value.
' ----------------------------------------------------------------------------------------------
If pCurrValue = 0# Then
Dim parameterRange As Range
If worksheetExists("config") Then
Dim rowIdx As Long
Set parameterRange = Worksheets("config").Range("ConfigParameters")
For rowIdx = 1 To parameterRange.rows.count
If (UCase(parameterRange(rowIdx, 1).value) = pParameter) Then
occurrence = occurrence + 1
If (occurrence = pOccurrence) Then
doubleParameter0200 = Val(parameterRange(rowIdx, 2).value)
Exit For
End If
End If
Next rowIdx
End If
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Private Sub setDoubleParameter0200(pParameter As String, pCurrValue As Double, Optional pOccurrence As Long = 1)
Dim occurrence As Long
occurrence = 0
pParameter = UCase(pParameter)
Dim parameterRange As Range
If worksheetExists("config") Then
Dim rowIdx As Long
Set parameterRange = Worksheets("config").Range("ConfigParameters")
For rowIdx = 1 To parameterRange.rows.count
If (UCase(parameterRange(rowIdx, 1).value) = pParameter) Then
occurrence = occurrence + 1
If (occurrence = pOccurrence) Then
parameterRange(rowIdx, 2).value = pCurrValue
Exit For
End If
End If
Next rowIdx
End If
End Sub
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Private Function dateParameter0200(pParameter As String, Optional pCurrValue As Date = #1/1/1993#, Optional pOccurrence As Long = 1) As Date
Dim occurrence As Long
occurrence = 0
dateParameter0200 = pCurrValue
pParameter = UCase(pParameter)
'
' ==============================================================================================
' we use static variables so that we only go through this one time for a given parameter. If
' the static variable is in an initialized state (0 or ""), then we look for the config sheet.
' Upon finding it, we look for the parameter and if it's found, we return its value. If the
' config sheet or the parameter is not found, then we return the initial state value.
' ----------------------------------------------------------------------------------------------
If pCurrValue = #1/1/1993# Then
Dim parameterRange As Range
If worksheetExists("config") Then
Dim rowIdx As Long
Set parameterRange = Worksheets("config").Range("ConfigParameters")
For rowIdx = 1 To parameterRange.rows.count
If (UCase(parameterRange(rowIdx, 1).value) = pParameter) Then
occurrence = occurrence + 1
If (occurrence = pOccurrence) Then
dateParameter0200 = DateValue(parameterRange(rowIdx, 2).value)
Exit For
End If
End If
Next rowIdx
End If
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Private Sub setDateParameter0200(pParameter As String, pCurrValue As Date, Optional pOccurrence As Long = 1)
Dim occurrence As Long
occurrence = 0
pParameter = UCase(pParameter)
Dim parameterRange As Range
If worksheetExists("config") Then
Dim rowIdx As Long
Set parameterRange = Worksheets("config").Range("ConfigParameters")
For rowIdx = 1 To parameterRange.rows.count
If (UCase(parameterRange(rowIdx, 1).value) = pParameter) Then
occurrence = occurrence + 1
If (occurrence = pOccurrence) Then
parameterRange(rowIdx, 2).value = pCurrValue
Exit For
End If
End If
Next rowIdx
End If
End Sub
Facebook