' ========================================================================================================================
' ____,__, __, ____,_, _, ____ ____,__, ,____,____,
' (-/_|(-| (-| (-|_,(-|\ | (-|__|-/_|( |_/(-|_,(-|__)
' _/ |,_|__,_|__,_|__,_| \|, _|__)/ |,_| \,_|__,_| \,
'
' 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
Facebook