image
 
image
M041_SetCellBackgrounds.bas


' ========================================================================================================================
'                                 ____,__,  __,  ____,_,  _,  ____ ____,__, ,____,____,
'                                (-/_|(-|  (-|  (-|_,(-|\ |  (-|__|-/_|( |_/(-|_,(-|__)
'                                _/  |,_|__,_|__,_|__,_| \|,  _|__)/  |,_| \,_|__,_|  \,
'
'                                             Copyright 2011 Allen Baker
'
' ------------------------------------------------------------------------------------------------------------------------
' File:       M041_SetCellBackgrounds
' Originator: Allen Baker (2011.01.29 16:52)
' LayoutRev:  1
' ========================================================================================================================
Option Explicit



' ========================================================================================================================
' Description
'    This module conditionally formats the background colors for the currenty selected range on the active sheet.
' ========================================================================================================================



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Constants  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



'
' ==============================================================================================
' see A008_RowsAndColumns.bas to get an understanding of what this is
' ----------------------------------------------------------------------------------------------
Private Const cDefaultPermutationString  As String = "3,2,4,1"
'
' ==============================================================================================
' color parameters
' ----------------------------------------------------------------------------------------------
'Private Const cDefaultSaturation  As Long = 100
Private Const cDefaultSaturation         As Long   = 200
Private Const cDefaultLightness          As Long   = 226
Private Const cDefaultLightnessIncrement As Long   = 12

Private Const cDefaultHue1 As Long = 0
Private Const cDefaultHue2 As Long = 64
Private Const cDefaultHue3 As Long = 128
Private Const cDefaultHue4 As Long = 192



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Module Variables  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



Private mInitialized        As Boolean
Private mPermutationString  As String
Private mSaturation         As Double
Private mLightness          As Long
Private mLightnessIncrement As Long
Private mHue(4)             As Double



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Public Routines  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' These routines set the conditional formatting of the currently selected cells to a set of colors that make
' it easier to see the rows and columns across the sheet.
' -----------------------------------------------------------------------------------------------------------
Public Sub setCellBackgroundColors()
   Call setGradedCellBackgroundColors(0)
End Sub


Public Sub setCellBackgroundColorsLight()
   Call setGradedCellBackgroundColors(1)
End Sub


Public Sub setCellBackgroundColorsLighter()
   Call setGradedCellBackgroundColors(2)
End Sub


Public Sub setCellBackgroundColorsDark()
   Call setGradedCellBackgroundColors(-1)
End Sub


Public Sub setCellBackgroundColorsDarker()
   Call setGradedCellBackgroundColors(-2)
End Sub


Public Sub setCellBackgroundColorsDarkest()
   Call setGradedCellBackgroundColors(-3)
End Sub

Public Sub SetCellBorders()
    ActiveWindow.DisplayGridlines = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -4.99893185216834E-02
        .weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -4.99893185216834E-02
        .weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -4.99893185216834E-02
        .weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -4.99893185216834E-02
        .weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -4.99893185216834E-02
        .weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -4.99893185216834E-02
        .weight = xlThin
    End With
End Sub


' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine sets the conditional formatting of the currently selected cells to a standard
' configuration that makes it easier to see the rows and columns across the sheet.  The user may pass in a
' grade which will lighten or darken the resulting colors
'
' param
'    pGrade is a scaling factor that will lighten or darken the resulting colors
' -----------------------------------------------------------------------------------------------------------
Public Sub setGradedCellBackgroundColors(pGrade As Integer)
   '
   ' ==============================================================================================
   ' use the default palette if things are not initialized yet
   ' ----------------------------------------------------------------------------------------------
   If (Not mInitialized) Then
      Call initialize _
         ( _
         cDefaultPermutationString, _
         cDefaultSaturation, _
         cDefaultLightness, _
         cDefaultLightnessIncrement, _
         cDefaultHue1, _
         cDefaultHue2, _
         cDefaultHue3, _
         cDefaultHue4 _
         )
   End If
   '
   ' ==============================================================================================
   ' here is where we grade the lightness.  The lightness is transformed according to pGrad and is
   ' not allowed to go outside the range of 0..255. These examples explain how grading works:
   ' +-----------------------+--------+---------------------+----------------------+
   ' | The Default Lightness | pGrade | The Grade Increment | The Graded Lightness |
   ' |-----------------------+--------+---------------------+----------------------|
   ' |        235            |   0    |          8          |         235          |
   ' |        235            |   1    |          8          |         243          |
   ' |        235            |   2    |          8          |         251          |
   ' |        235            |   3    |          8          |         255          |
   ' |        235            |   -1   |          8          |         227          |
   ' |        235            |   -2   |          8          |         219          |
   ' |        235            |   -3   |          8          |         211          |
   ' +-----------------------+--------+---------------------+----------------------+
   ' ----------------------------------------------------------------------------------------------
   Dim lightness As Double
   lightness = CDbl(forceIntoRange(mLightness + (pGrade * mLightnessIncrement), 0, 255))
   '
   ' ==============================================================================================
   ' these are the colors we use to tint the rows and columns to make them easier to follow
   ' ----------------------------------------------------------------------------------------------
   Dim colors(4) As Long
   colors(1) = hslToRgb(mHue(1), mSaturation, lightness)
   colors(2) = hslToRgb(mHue(2), mSaturation, lightness)
   colors(3) = hslToRgb(mHue(3), mSaturation, lightness)
   colors(4) = hslToRgb(mHue(4), mSaturation, lightness)
   '
   ' ==============================================================================================
   ' set the conditional formatting for the selected range
   ' ----------------------------------------------------------------------------------------------
   Call setConditionalFillColors(colors, mPermutationString)
End Sub



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine allows the user to change the saturation used to set the cell background colors
'
' param
'    pSaturation the new color saturation
' -----------------------------------------------------------------------------------------------------------
Public Sub setCellBackgroundSaturation(pSaturation As Long)
   If (mInitialized) Then
      mSaturation = CDbl(pSaturation)
   Else
      Call initialize _
         ( _
         cDefaultPermutationString, _
         pSaturation, _
         cDefaultLightness, _
         cDefaultLightnessIncrement, _
         cDefaultHue1, _
         cDefaultHue2, _
         cDefaultHue3, _
         cDefaultHue4 _
         )
   End If
End Sub



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine allows the user to change the lightness used to set the cell background colors
'
' param
'    pLightness the new color lightness
' -----------------------------------------------------------------------------------------------------------
Public Sub setCellBackgroundLightness(pLightness As Long)
   If (mInitialized) Then
      mLightness = CDbl(pLightness)
   Else
      Call initialize _
         ( _
         cDefaultPermutationString, _
         cDefaultSaturation, _
         pLightness, _
         cDefaultLightnessIncrement, _
         cDefaultHue1, _
         cDefaultHue2, _
         cDefaultHue3, _
         cDefaultHue4 _
         )
   End If
End Sub



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine allows the user to change the lightness increment used to scale the cell background colors
'
' param
'    pLightness the new lightness increment
' -----------------------------------------------------------------------------------------------------------
Public Sub setCellBackgroundLightnessIncrement(pLightnessIncrement As Long)
   If (mInitialized) Then
      mLightnessIncrement = pLightnessIncrement
   Else
      Call initialize _
         ( _
         cDefaultPermutationString, _
         cDefaultSaturation, _
         cDefaultLightness, _
         pLightnessIncrement, _
         cDefaultHue1, _
         cDefaultHue2, _
         cDefaultHue3, _
         cDefaultHue4 _
         )
   End If
End Sub



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine allows the user to change the palette of hues used to set the cell background colors
'
' param
'    pHue1, pHue2, pHue3, pHue4 are the new color hues
' -----------------------------------------------------------------------------------------------------------
Public Sub setCellBackgroundHuePalette(pHue1 As Long, pHue2 As Long, pHue3 As Long, pHue4 As Long)
   If (mInitialized) Then
      mHue(1) = CDbl(pHue1)
      mHue(2) = CDbl(pHue2)
      mHue(3) = CDbl(pHue3)
      mHue(4) = CDbl(pHue4)
   Else
      Call initialize _
         ( _
         cDefaultPermutationString, _
         cDefaultSaturation, _
         cDefaultLightness, _
         cDefaultLightnessIncrement, _
         pHue1, _
         pHue2, _
         pHue3, _
         pHue4 _
         )
   End If
End Sub



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' These functions allow the user to get the default values used in this module
' -----------------------------------------------------------------------------------------------------------
Public Function getDefaultCellBackgroundPermutationString() As String
   getDefaultCellBackgroundPermutationString = cDefaultPermutationString
End Function

Public Function getDefaultCellBackgroundSaturation() As Long
   getDefaultCellBackgroundSaturation = cDefaultSaturation
End Function

Public Function getDefaultCellBackgroundLightness() As Long
   getDefaultCellBackgroundLightness = cDefaultLightness
End Function

Public Function getDefaultCellBackgroundLightnessIncrement() As Long
   getDefaultCellBackgroundLightnessIncrement = cDefaultLightnessIncrement
End Function

Public Function getDefaultCellBackgroundHue1() As Long
   getDefaultCellBackgroundHue1 = cDefaultHue1
End Function

Public Function getDefaultCellBackgroundHue2() As Long
   getDefaultCellBackgroundHue2 = cDefaultHue2
End Function

Public Function getDefaultCellBackgroundHue3() As Long
   getDefaultCellBackgroundHue3 = cDefaultHue3
End Function

Public Function getDefaultCellBackgroundHue4() As Long
   getDefaultCellBackgroundHue4 = cDefaultHue4
End Function



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Private Routines  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine initializes all the module variables
' -----------------------------------------------------------------------------------------------------------
Private Sub initialize _
   ( _
   pPermutationString As String, _
   pSaturation As Long, _
   pLightness As Long, _
   pLightnessIncrement As Long, _
   pHue1 As Long, _
   pHue2 As Long, _
   pHue3 As Long, _
   pHue4 As Long _
   )
   mPermutationString = pPermutationString
   mSaturation = CDbl(pSaturation)
   mLightness = pLightness
   mLightnessIncrement = pLightnessIncrement
   mHue(1) = CDbl(pHue1)
   mHue(2) = CDbl(pHue2)
   mHue(3) = CDbl(pHue3)
   mHue(4) = CDbl(pHue4)
   mInitialized = True
End Sub



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine sets the conditional formatting on the selected range using the specified colors.
'
' param
'    pColor is an array of the colors to set
' param
'    pPermutationString is a string that identifies which permutation of the 4 colors in pColor that pSheet
'    is using
' -----------------------------------------------------------------------------------------------------------
Private Sub setConditionalFillColors(pColors() As Long, pPermutationString)
   '
   ' ==============================================================================================
   ' extract the permutation of indexes from the permutation string, convert them into numbers,
   ' and put them into an array of index numbers in the same order as they are in the permutation
   ' string. They will be used as the indexes into pColors
   ' ----------------------------------------------------------------------------------------------
   Dim tokens() As String
   Dim i        As Long
   Dim iString  As Variant
   Dim index(4) As Long
   tokens = Split(pPermutationString, ",")
   i = 1
   For Each iString In tokens
      index(i) = CLng(iString)
      i = i + 1
   Next iString
   ' ==============================================================================================
   ' set the conditions for the 4 color permutation starting with even-row, even-column cells
   ' ----------------------------------------------------------------------------------------------
   Dim formula1 As String
   formula1 = "=AND((MOD(ROW(),2)=0),(MOD(COLUMN(),2)=0))"
   Call deleteSpecificConditionalFormat(Selection, formula1)
   Selection.FormatConditions.Add Type:=xlExpression, formula1:=formula1
   Selection.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
   With Selection.FormatConditions(1).Interior
      .PatternColorIndex = xlAutomatic
      .color = pColors(index(1))
      .TintAndShade = 0
   End With
   Selection.FormatConditions(1).StopIfTrue = False
   '
   ' ==============================================================================================
   ' even-row, odd-column cells
   ' ----------------------------------------------------------------------------------------------
   formula1 = "=AND((MOD(ROW(),2)=0),(MOD(COLUMN(),2)=1))"
   Call deleteSpecificConditionalFormat(Selection, formula1)
   Selection.FormatConditions.Add Type:=xlExpression, formula1:=formula1
   Selection.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
   With Selection.FormatConditions(1).Interior
      .PatternColorIndex = xlAutomatic
      .color = pColors(index(2))
      .TintAndShade = 0
   End With
   Selection.FormatConditions(1).StopIfTrue = False
   '
   ' ==============================================================================================
   ' odd-row, even-column cells
   ' ----------------------------------------------------------------------------------------------
   formula1 = "=AND((MOD(ROW(),2)=1),(MOD(COLUMN(),2)=0))"
   Call deleteSpecificConditionalFormat(Selection, formula1)
   Selection.FormatConditions.Add Type:=xlExpression, formula1:=formula1
   Selection.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
   With Selection.FormatConditions(1).Interior
      .PatternColorIndex = xlAutomatic
      .color = pColors(index(3))
      .TintAndShade = 0
   End With
   Selection.FormatConditions(1).StopIfTrue = False
   '
   ' ==============================================================================================
   ' odd-row, odd-column cells
   ' ----------------------------------------------------------------------------------------------
   formula1 = "=AND((MOD(ROW(),2)=1),(MOD(COLUMN(),2)=1))"
   Call deleteSpecificConditionalFormat(Selection, formula1)
   Selection.FormatConditions.Add Type:=xlExpression, formula1:=formula1
   Selection.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
   With Selection.FormatConditions(1).Interior
      .PatternColorIndex = xlAutomatic
      .color = pColors(index(4))
      .TintAndShade = 0
   End With
   Selection.FormatConditions(1).StopIfTrue = False
End Sub