"Main" module
----------------------------------------------------------------------------------------
Option Explicit
Public Datalists As Collection
Public Metadatas As Collection
Public Sub Main()
Call ShowBread
Call PopulateDatalists
Call PopulateMetadatas
Call AddPlaceToDatalists
Call AddStandardToDatalists
Call AddLastChildToDatalists
Call DisplayDatalists
End Sub
Private Function AddLastChildToDatalists()
Dim i As Long
Dim j As Long
Dim hitVector() As Variant
ReDim hitVector(1 To Metadatas.Item(1).CountDifferent(), 1 To 2)
For i = 1 To Metadatas.Item(1).CountDifferent()
For j = 1 To Datalists.Count
If Datalists.Item(j).Grouping = i Then
hitVector(i, 1) = j
hitVector(i, 2) = i
End If
Next j
Next i
For i = 1 To Metadatas.Item(1).CountDifferent()
Datalists.Item(hitVector(i, 1)).LastChild = hitVector(i, 2)
Next i
End Function
Private Function AddStandardToDatalists()
Dim i As Long
Dim j As Long
Dim temp1 As String
Dim temp2 As Double
Dim endMarker As Double
Dim sortBoolean As Boolean
Dim sortVector() As Variant
j = 0
ReDim sortVector(1 To Metadatas.Item(1).CountNotEmpty(), 1 To 3)
For i = 1 To Datalists.Count
If Datalists.Item(i).NotEmpty = True Then
j = j + 1
sortVector(j, 1) = Datalists.Item(i).Entry
sortVector(j, 2) = Datalists.Item(i).Sequence
sortVector(j, 3) = 0
End If
Next i
endMarker = Metadatas.Item(1).CountNotEmpty() - 1
sortBoolean = True
Do While sortBoolean = True
sortBoolean = False
For i = 1 To endMarker
If sortVector(i, 1) > sortVector(i + 1, 1) Then
temp1 = sortVector(i, 1)
temp2 = sortVector(i, 2)
sortVector(i, 1) = sortVector(i + 1, 1)
sortVector(i, 2) = sortVector(i + 1, 2)
sortVector(i + 1, 1) = temp1
sortVector(i + 1, 2) = temp2
sortBoolean = True
End If
Next i
endMarker = endMarker - 1
Loop
j = 1
sortVector(1, 3) = j
For i = 1 To Metadatas.Item(1).CountNotEmpty() - 1
If sortVector(i, 1) = sortVector(i + 1, 1) Then
sortVector(i + 1, 3) = j
Else
j = j + 1
sortVector(i + 1, 3) = j
End If
Next i
For i = 1 To Metadatas.Item(1).CountNotEmpty()
Datalists.Item(sortVector(i, 2)).Grouping = sortVector(i, 3)
Next i
End Function
Private Function AddPlaceToDatalists()
Dim i As Long
Dim j As Long
Dim temp1 As String
Dim temp2 As Double
Dim endMarker As Double
Dim sortBoolean As Boolean
Dim sortVector() As Variant
j = 0
ReDim sortVector(1 To Metadatas.Item(1).CountNotEmpty(), 1 To 2)
For i = 1 To Datalists.Count
If Datalists.Item(i).NotEmpty = True Then
j = j + 1
sortVector(j, 1) = Datalists.Item(i).Entry
sortVector(j, 2) = Datalists.Item(i).Sequence
End If
Next i
endMarker = Metadatas.Item(1).CountNotEmpty() - 1
sortBoolean = True
Do While sortBoolean = True
sortBoolean = False
For i = 1 To endMarker
If sortVector(i, 1) > sortVector(i + 1, 1) Then
temp1 = sortVector(i, 1)
temp2 = sortVector(i, 2)
sortVector(i, 1) = sortVector(i + 1, 1)
sortVector(i, 2) = sortVector(i + 1, 2)
sortVector(i + 1, 1) = temp1
sortVector(i + 1, 2) = temp2
sortBoolean = True
End If
Next i
endMarker = endMarker - 1
Loop
For i = 1 To Metadatas.Item(1).CountNotEmpty()
Datalists.Item(sortVector(i, 2)).Place = i
Next i
End Function
Public Function PopulateMetadatas()
Set Metadatas = New Collection
Dim m As Metadata
Set m = New Metadata
Metadatas.Add m
End Function
Public Function PopulateDatalists()
Dim i As Long
Dim d As Datalist
Set Datalists = New Collection
Worksheets("Blad1").Activate
i = 0
Do
i = i + 1
Set d = New Datalist
Datalists.Add d
Datalists.Item(i).Sequence = i
Datalists.Item(i).Entry = Cells(i, 1).Value
Datalists.Item(i).IsNotEmpty
Datalists.Item(i).Place = 0
Datalists.Item(i).Grouping = 0
Datalists.Item(i).LastChild = 0
Loop While Datalists.Item(i).Entry <> "CCCDDD"
Datalists.Remove (i)
End Function
Public Function DisplayDatalists()
Dim i As Long
Worksheets("Blad2").Activate
ActiveSheet.Cells.Clear
For i = 1 To Datalists.Count
Cells(i, 1).Value = Datalists.Item(i).Sequence
Cells(i, 2).Value = Datalists.Item(i).Entry
Cells(i, 3).Value = Datalists.Item(i).NotEmpty
Cells(i, 4).Value = Datalists.Item(i).Place
Cells(i, 5).Value = Datalists.Item(i).Grouping
Cells(i, 6).Value = Datalists.Item(i).LastChild
Cells(i, 7).Value = Datalists.Item(i).Keeper
Next i
End Function
Public Function ShowBread()
Dim i As Long
Dim vBread(1 To 29) As String
vBread(1) = ""
vBread(2) = "nor"
vBread(3) = ""
vBread(4) = ""
vBread(5) = "norflox"
vBread(6) = ""
vBread(7) = ""
vBread(8) = "cip"
vBread(9) = "cipr"
vBread(10) = ""
vBread(11) = ""
vBread(12) = "cipro"
vBread(13) = ""
vBread(14) = ""
vBread(15) = "ciproflox"
vBread(16) = ""
vBread(17) = "cipr"
vBread(18) = ""
vBread(19) = "norfloxa"
vBread(20) = ""
vBread(21) = "noorflox"
vBread(22) = "cipro"
vBread(23) = ""
vBread(24) = ""
vBread(25) = "ciproflox"
vBread(26) = "nor"
vBread(27) = ""
vBread(28) = ""
vBread(29) = "CCCDDD"
Worksheets("Blad1").Activate
ActiveSheet.Cells.Clear
For i = LBound(vBread) To UBound(vBread)
Cells(i, 1).Value = vBread(i)
Next i
End Function
"Datalist" class module
--------------------------------------------------------------------------------------
Option Explicit
Public Sequence As Double
Public Entry As String
Public NotEmpty As Boolean
Public Place As Double
Public Grouping As Double
Public LastChild As Double
Public Keeper As Boolean
Private Sub Class_Initialize()
Me.Sequence = 0
Me.Entry = ""
Me.NotEmpty = False
Me.Place = 0
Me.Grouping = 0
Me.LastChild = 0
Me.Keeper = False
End Sub
Public Sub IsNotEmpty()
If Me.Entry <> "" Then
Me.NotEmpty = True
End If
End Sub
"Metadata" class module
--------------------------------------------------------------------------------------
Option Explicit
Public Function CountNotEmpty()
Dim i As Long
Dim j As Double
j = 0
For i = 1 To Datalists.Count
If Datalists.Item(i).NotEmpty = True Then
j = j + 1
End If
Next i
CountNotEmpty = j
End Function
Public Function CountDifferent()
Dim i As Long
Dim j As Double
j = 0
For i = 1 To Datalists.Count
If Datalists.Item(i).Grouping > j Then
j = Datalists.Item(i).Grouping
End If
Next i
CountDifferent = j
End Function
"Blad3" workbook code-behind
--------------------------------------------------------------------------------------
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call DoThings(ActiveCell.Row, ActiveCell.Column)
End Sub
"Main Graphics" module
--------------------------------------------------------------------------------------
Option Explicit
Public Datasheets As Collection
Public Datacells As Collection
Public Sub Main()
Dim i As Long
Dim j As Long
Set Datasheets = New Collection
Set Datacells = New Collection
Dim ds As Datasheet
Set ds = New Datasheet
Datasheets.Add ds
Call Datasheets.Item(1).Clear_GUI
Call Datasheets.Item(1).Create_Datacells
Call Datasheets.Item(1).Upgrade_Datacells
End Sub
Public Sub DoThings(ByVal value1 As Double, ByVal value2 As Double)
Dim i As Long
Dim j As Long
Dim hit As Boolean
Dim index As Double
Dim indexRowMin As Double
Dim indexRowMax As Double
index = Datasheets.Item(1).Find_Cell_Index(value1, value2)
If index > 0 Then
If Datacells.Item(index).ColorName = Datasheets.Item(1).GrayColorName Then
indexRowMin = Datasheets.Item(1).Find_Lowest_Index_On_This_Row(value1)
indexRowMax = Datasheets.Item(1).Find_Highest_Index_On_This_Row(value1)
For i = indexRowMin To indexRowMax
Datacells.Item(i).Set_Gray
Next i
Call Datacells.Item(index).Set_No
ElseIf Datacells.Item(index).ColorName = Datasheets.Item(1).NoColorName Then
indexRowMin = Datasheets.Item(1).Find_Lowest_Index_On_This_Row(value1)
indexRowMax = Datasheets.Item(1).Find_Highest_Index_On_This_Row(value1)
For i = indexRowMin To indexRowMax
Datacells.Item(i).Set_Gray
Next i
End If
End If
For i = 1 To Datacells.Count
If Datacells.Item(i).Purpose = Datasheets.Item(1).PurposeHeader Then
Datacells.Item(i).Set_Red
End If
Next i
For i = 1 To Datacells.Count
If Datacells.Item(i).ColorName = Datasheets.Item(1).NoColorName Then
For j = 1 To Datacells.Count
If Datacells.Item(j).Purpose = Datasheets.Item(1).PurposeHeader Then
If Datacells.Item(j).SheetRow = Datacells.Item(i).SheetRow Or Datacells.Item(j).SheetCol = Datacells.Item(i).SheetCol Then
Datacells.Item(j).Set_Green
End If
End If
Next j
End If
Next i
hit = False
For i = 1 To Datacells.Count
If Datacells.Item(i).ColorName = Datasheets.Item(1).RedColorName Then
hit = True
End If
If hit = False Then
Datacells.Item(1).Content = Datasheets.Item(1).MatchContent
Else
Datacells.Item(1).Content = ""
End If
Next i
Call Datasheets.Item(1).Upgrade_Datacells
End Sub
"Datacell" class module
--------------------------------------------------------------------------------------
Option Explicit
Public IsBold As Boolean
Public ColorCode As Double
Public ColorName As String
Public Content As String
Public Purpose As String
Public SheetRow As Double
Public SheetCol As Double
Public VectorRow As Double
Public VectorCol As Double
Private Sub Class_Initialize()
Me.IsBold = False
Me.ColorCode = Datasheets.Item(1).GrayColorCode
Me.ColorName = Datasheets.Item(1).GrayColorName
Me.Content = Datasheets.Item(1).DefaultContent
Me.Purpose = Datasheets.Item(1).PurposeGeneral
Me.SheetRow = 0
Me.SheetCol = 0
Me.VectorRow = 0
Me.VectorCol = 0
End Sub
Public Sub Upgrade_Screen()
Cells(Me.SheetRow, Me.SheetCol).Value = Me.Content
Cells(Me.SheetRow, Me.SheetCol).Font.Color = Me.ColorCode
Cells(Me.SheetRow, Me.SheetCol).Font.Bold = Me.IsBold
End Sub
Public Sub Set_Location(ByVal value1 As Double, ByVal value2 As Double)
Me.SheetRow = value1
Me.SheetCol = value2
Me.VectorRow = Me.SheetRow
Me.VectorCol = Me.SheetCol
End Sub
Public Sub Set_Red()
Me.IsBold = True
Me.ColorCode = Datasheets.Item(1).RedColorCode
Me.ColorName = Datasheets.Item(1).RedColorName
End Sub
Public Sub Set_Blue()
Me.IsBold = False
Me.ColorCode = Datasheets.Item(1).BlueColorCode
Me.ColorName = Datasheets.Item(1).BlueColorName
End Sub
Public Sub Set_Green()
Me.IsBold = False
Me.ColorCode = Datasheets.Item(1).GreenColorCode
Me.ColorName = Datasheets.Item(1).GreenColorName
End Sub
Public Sub Set_Gray()
Me.IsBold = False
Me.ColorCode = Datasheets.Item(1).GrayColorCode
Me.ColorName = Datasheets.Item(1).GrayColorName
End Sub
Public Sub Set_Gold()
Me.IsBold = False
Me.ColorCode = Datasheets.Item(1).GoldColorCode
Me.ColorName = Datasheets.Item(1).GoldColorName
End Sub
Public Sub Set_No()
Me.IsBold = False
Me.ColorCode = Datasheets.Item(1).NoColorCode
Me.ColorName = Datasheets.Item(1).NoColorName
End Sub
"Datasheet" class module
--------------------------------------------------------------------------------------
Option Explicit
Public WS As String
Public Home As String
Public RowMin As Double
Public ColMin As Double
Public RowMax As Double
Public ColMax As Double
Public ActiveRowMin As Double
Public ActiveColMin As Double
Public RedColorCode As Double
Public BlueColorCode As Double
Public GreenColorCode As Double
Public GrayColorCode As Double
Public GoldColorCode As Double
Public NoColorCode As Double
Public RedColorName As String
Public BlueColorName As String
Public GreenColorName As String
Public GrayColorName As String
Public GoldColorName As String
Public NoColorName As String
Public DefaultContent As String
Public MatchContent As String
Public PurposeOrigo As String
Public PurposeHeader As String
Public PurposeGeneral As String
Private Sub Class_Initialize()
Me.WS = "Blad3"
Me.Home = "A1"
Me.RowMin = 1
Me.ColMin = 1
Me.RowMax = 15
Me.ColMax = 5
Me.ActiveRowMin = 2
Me.ActiveColMin = 2
Me.RedColorCode = 238
Me.BlueColorCode = 16741960
Me.GreenColorCode = 1343536
Me.GrayColorCode = 14408667
Me.GoldColorCode = 962030
Me.NoColorCode = 0
Me.RedColorName = "Red"
Me.BlueColorName = "Blue"
Me.GreenColorName = "Green"
Me.GrayColorName = "Gray"
Me.GoldColorName = "Gold"
Me.NoColorName = "No"
Me.DefaultContent = "*"
Me.MatchContent = "MATCH"
Me.PurposeOrigo = "Origo"
Me.PurposeHeader = "Header"
Me.PurposeGeneral = "General"
End Sub
Public Sub Clear_GUI()
Worksheets(Me.WS).Activate
ActiveSheet.Cells.Clear
End Sub
Public Sub Create_Datacells()
Dim i As Long
Dim j As Long
Dim dc As Datacell
For i = 1 To Me.RowMax
For j = 1 To Me.ColMax
Set dc = New Datacell
Datacells.Add dc
Call Datacells.Item(Datacells.Count).Set_Location(i, j)
Next j
Next i
For i = 1 To Datacells.Count
If Datacells.Item(i).SheetRow = 1 And Datacells.Item(i).SheetCol = 1 Then
Datacells.Item(i).Purpose = Me.PurposeOrigo
Datacells.Item(i).Content = ""
Call Datacells.Item(i).Set_Gold
ElseIf Datacells.Item(i).SheetRow = 1 And Datacells.Item(i).SheetCol >= Me.ActiveColMin Then
Datacells.Item(i).Purpose = Me.PurposeHeader
Call Datacells.Item(i).Set_Red
ElseIf Datacells.Item(i).SheetCol = 1 And Datacells.Item(i).SheetRow >= Me.ActiveRowMin Then
Datacells.Item(i).Purpose = Me.PurposeHeader
Call Datacells.Item(i).Set_Red
End If
Next i
End Sub
Public Sub Upgrade_Datacells()
Dim i As Long
For i = 1 To Datacells.Count
Call Datacells.Item(i).Upgrade_Screen
Next i
End Sub
Public Function Find_Cell_Index(ByVal value1 As Double, ByVal value2 As Double) As Double
Dim i As Long
If value1 >= Me.ActiveRowMin And value1 <= Me.RowMax And value2 >= Me.ActiveColMin And value2 <= Me.ColMax Then
For i = 1 To Datacells.Count
If Datacells.Item(i).SheetRow = value1 And Datacells.Item(i).SheetCol = value2 Then
Find_Cell_Index = i
End If
Next i
Else
Find_Cell_Index = 0
End If
End Function
Public Function Find_Lowest_Index_On_This_Row(ByVal value1 As Double) As Double
Dim i As Long
For i = 1 To Datacells.Count
If Datacells.Item(i).SheetRow = value1 And Datacells.Item(i).SheetCol = Me.ActiveColMin Then
Find_Lowest_Index_On_This_Row = i
End If
Next i
End Function
Public Function Find_Highest_Index_On_This_Row(ByVal value1 As Double) As Double
Dim i As Long
For i = 1 To Datacells.Count
If Datacells.Item(i).SheetRow = value1 And Datacells.Item(i).SheetCol = Me.ColMax Then
Find_Highest_Index_On_This_Row = i
End If
Next i
End Function
"Main" module
--------------------------------------------------------------------------------------
Option Explicit
Public Definitions As Collection
Public States As Dictionary
Public DataPoints As Collection
Public Sub Main()
Dim i As Long
Dim j As Long
Set Definitions = New Collection
Dim d As Definition
Set d = New Definition
Definitions.Add d
Call Create_States
Worksheets("Blad1").Activate
ActiveSheet.Cells.Clear
Set DataPoints = New Collection
Dim dp As DataPoint
For i = 1 To 10
For j = 1 To 10
Set dp = New DataPoint
DataPoints.Add dp
Call DataPoints.Item(DataPoints.Count).Set_DataPoint(DataPoints.Count, i, j, "*", Definitions.Item(1).GeneralOff)
Next j
Next i
Call Display_DataPoints
End Sub
Public Sub Create_States()
Set States = New Dictionary
Dim s1 As State
Set s1 = New State
States.Add Definitions.Item(1).OrigoOn, s1
Dim s2 As State
Set s2 = New State
States.Add Definitions.Item(1).OrigoOff, s2
Dim s3 As State
Set s3 = New State
States.Add Definitions.Item(1).HorizontalHeaderOn, s3
Dim s4 As State
Set s4 = New State
States.Add Definitions.Item(1).HorizontalHeaderOff, s4
Dim s5 As State
Set s5 = New State
States.Add Definitions.Item(1).VerticalHeaderOn, s5
Dim s6 As State
Set s6 = New State
States.Add Definitions.Item(1).VerticalHeaderOff, s6
Dim s7 As State
Set s7 = New State
States.Add Definitions.Item(1).GeneralOn, s7
Dim s8 As State
Set s8 = New State
States.Add Definitions.Item(1).GeneralOff, s8
States.Item(Definitions.Item(1).OrigoOn).Set_OrigoOn
States.Item(Definitions.Item(1).OrigoOff).Set_OrigoOff
States.Item(Definitions.Item(1).HorizontalHeaderOn).Set_HorizontalHeaderOn
States.Item(Definitions.Item(1).HorizontalHeaderOff).Set_HorizontalHeaderOff
States.Item(Definitions.Item(1).VerticalHeaderOn).Set_VerticalHeaderOn
States.Item(Definitions.Item(1).VerticalHeaderOff).Set_VerticalHeaderOff
States.Item(Definitions.Item(1).GeneralOn).Set_GeneralOn
States.Item(Definitions.Item(1).GeneralOff).Set_GeneralOff
End Sub
Public Sub Display_DataPoints()
Dim i As Long
For i = 1 To DataPoints.Count
With Cells(DataPoints.Item(i).RowNumber, DataPoints.Item(i).ColumnNumber)
.Value = DataPoints.Item(i).Content
.Font.Color = States.Item(DataPoints.Item(i).PurposeState).ColorCode
.Font.Bold = States.Item(DataPoints.Item(i).PurposeState).IsBold
End With
Next i
End Sub
"DataPoint" class module
--------------------------------------------------------------------------------------
Option Explicit
Public Index As Double
Public ColumnNumber As Long
Public RowNumber As Long
Public Content As String
Public PurposeState As String
Private Sub Class_Initialize()
Me.Index = 0
Me.ColumnNumber = 0
Me.RowNumber = 0
Me.Content = Definitions.Item(1).Content
Me.PurposeState = Definitions.Item(1).GeneralOff
End Sub
Public Sub Set_DataPoint(ByVal value1 As Double, ByVal value2 As Long, ByVal value3 As Long, ByVal value4 As String, ByVal value5 As String)
Me.Index = value1
Me.RowNumber = value2
Me.ColumnNumber = value3
Me.Content = value4
Me.PurposeState = value5
End Sub
"Definition" class module
--------------------------------------------------------------------------------------
Option Explicit
Public RedCode As Double
Public BlueCode As Double
Public GreenCode As Double
Public GrayCode As Double
Public GoldCode As Double
Public BlackCode As Double
Public RedName As String
Public BlueName As String
Public GreenName As String
Public GrayName As String
Public GoldName As String
Public BlackName As String
Public Origo As String
Public HorizontalHeader As String
Public VerticalHeader As String
Public General As String
Public StateOn As String
Public StateOff As String
Public OrigoOn As String
Public OrigoOff As String
Public HorizontalHeaderOn As String
Public HorizontalHeaderOff As String
Public VerticalHeaderOn As String
Public VerticalHeaderOff As String
Public GeneralOn As String
Public GeneralOff As String
Public Content As String
Private Sub Class_Initialize()
Me.RedCode = 238
Me.BlueCode = 16741960
Me.GreenCode = 1343536
Me.GrayCode = 14408667
Me.GoldCode = 962030
Me.BlackCode = 0
Me.RedName = "Red"
Me.BlueName = "Blue"
Me.GreenName = "Green"
Me.GrayName = "Gray"
Me.GoldName = "Gold"
Me.BlackName = "Black"
Me.Origo = "Origo"
Me.HorizontalHeader = "HorizontalHeader"
Me.VerticalHeader = "VerticalHeader"
Me.General = "General"
Me.StateOn = "On"
Me.StateOff = "Off"
Me.OrigoOn = "OrigoOn"
Me.OrigoOff = "OrigoOffName"
Me.HorizontalHeaderOn = "HorizontalHeaderOn"
Me.HorizontalHeaderOff = "HorizontalHeaderOff"
Me.VerticalHeaderOn = "VerticalHeaderOn"
Me.VerticalHeaderOff = "VerticalHeaderOff"
Me.GeneralOn = "GeneralOn"
Me.GeneralOff = "GeneralOff"
Me.Content = "*"
End Sub
"State" class module
--------------------------------------------------------------------------------------
Option Explicit
Public IsBold As Boolean
Public ColorCode As Double
Public ColorName As String
Public Purpose As String
Public State As String
Public PurposeState As String
Public Content As String
Private Sub Class_Initialize()
Me.IsBold = False
Me.ColorCode = Definitions.Item(1).GrayCode
Me.ColorName = Definitions.Item(1).GrayName
Me.Purpose = Definitions.Item(1).General
Me.State = Definitions.Item(1).StateOff
Me.PurposeState = Definitions.Item(1).GeneralOff
Me.Content = Definitions.Item(1).Content
End Sub
Public Sub Set_OrigoOn()
Me.IsBold = False
Me.ColorCode = Definitions.Item(1).GoldCode
Me.ColorName = Definitions.Item(1).GoldName
Me.Purpose = Definitions.Item(1).Origo
Me.State = Definitions.Item(1).StateOn
Me.PurposeState = Definitions.Item(1).OrigoOn
End Sub
Public Sub Set_OrigoOff()
Me.IsBold = False
Me.ColorCode = Definitions.Item(1).GoldCode
Me.ColorName = Definitions.Item(1).GoldName
Me.Purpose = Definitions.Item(1).Origo
Me.State = Definitions.Item(1).StateOff
Me.PurposeState = Definitions.Item(1).OrigoOff
End Sub
Public Sub Set_HorizontalHeaderOn()
Me.IsBold = False
Me.ColorCode = Definitions.Item(1).GreenCode
Me.ColorName = Definitions.Item(1).GreenName
Me.Purpose = Definitions.Item(1).HorizontalHeader
Me.State = Definitions.Item(1).StateOn
Me.PurposeState = Definitions.Item(1).HorizontalHeaderOn
End Sub
Public Sub Set_HorizontalHeaderOff()
Me.IsBold = True
Me.ColorCode = Definitions.Item(1).RedCode
Me.ColorName = Definitions.Item(1).RedName
Me.Purpose = Definitions.Item(1).HorizontalHeader
Me.State = Definitions.Item(1).StateOff
Me.PurposeState = Definitions.Item(1).HorizontalHeaderOff
End Sub
Public Sub Set_VerticalHeaderOn()
Me.IsBold = False
Me.ColorCode = Definitions.Item(1).GreenCode
Me.ColorName = Definitions.Item(1).GreenName
Me.Purpose = Definitions.Item(1).VerticalHeader
Me.State = Definitions.Item(1).StateOn
Me.PurposeState = Definitions.Item(1).VerticalHeaderOn
End Sub
Public Sub Set_VerticalHeaderOff()
Me.IsBold = True
Me.ColorCode = Definitions.Item(1).RedCode
Me.ColorName = Definitions.Item(1).RedName
Me.Purpose = Definitions.Item(1).VerticalHeader
Me.State = Definitions.Item(1).StateOff
Me.PurposeState = Definitions.Item(1).VerticalHeaderOff
End Sub
Public Sub Set_GeneralOn()
Me.IsBold = False
Me.ColorCode = Definitions.Item(1).BlackCode
Me.ColorName = Definitions.Item(1).BlackName
Me.Purpose = Definitions.Item(1).General
Me.State = Definitions.Item(1).StateOn
Me.PurposeState = Definitions.Item(1).GeneralOn
End Sub
Public Sub Set_GeneralOff()
Me.IsBold = False
Me.ColorCode = Definitions.Item(1).GrayCode
Me.ColorName = Definitions.Item(1).GrayName
Me.Purpose = Definitions.Item(1).General
Me.State = Definitions.Item(1).StateOff
Me.PurposeState = Definitions.Item(1).GeneralOff
End Sub