Private Sub RefreshSubcategoryCheckBox(CheckBox As Object)
Dim rngSubcategoryCol As Excel.Range
Dim rngResult As Excel.Range
Dim FndText As String
FndText = Replace(CheckBox.Name, "scC_", "")
FndText = Sheets(SC_WKS_SRC_NAME).Range(FndText).Text
Set rngSubcategoryCol = ThisWorkbook.Worksheets(SC_WKS_DATATABLE_NAME).Columns("G")
Set rngResult = rngSubcategoryCol.Find(FndText, LookIn:=xlValues, LookAt:=xlWhole)
CheckBox.Value = Not (rngResult Is Nothing)
End Sub
Private Function CreateSubcategory(SubcategoryCell As Excel.Range) As Boolean
Dim rngFirstSubCatCell As Excel.Range
Dim shpFrame As Excel.Shape
Dim shpChk As Excel.Shape
Set rngFirstSubCatCell = ThisWorkbook.Worksheets(SC_WKS_SRC_NAME).Range(SC_WKS_SRC_1ST_CELLADDRESS)
With ThisWorkbook.Worksheets(SC_WKS_DST_NAME).Shapes
Set shpFrame = .AddShape(MsoAutoShapeType.msoShapeRoundedRectangle, _
Left:=SC_FRM_ANCHOR_LEFT * (1! + (SubcategoryCell.column - rngFirstSubCatCell.column)), _
Top:=SC_FRM_ANCHOR_TOP + SC_FRM_MARGIN_TOP * (SubcategoryCell.row - rngFirstSubCatCell.row), _
Width:=SC_FRM_WIDTH, _
Height:=SC_FRM_HEIGHT)
With shpFrame
.Name = SC_FRM_PREFIX & Replace$(SubcategoryCell.Address, "$", "")
.Fill.ForeColor.RGB = rgbWhite
With .TextFrame2
.VerticalAnchor = msoAnchorMiddle
.HorizontalAnchor = msoAnchorCenter
.TextRange.Font.Fill.ForeColor.RGB = rgbBlack
.TextRange.Text = Trim$(SubcategoryCell.Text)
End With
.OnAction = SC_MODULE_NAME & ".SubcategoryFrame_Click"
End With
Set shpChk = .AddFormControl(XlFormControl.xlCheckBox, _
Left:=0, _
Top:=0, _
Width:=0, _
Height:=0)
With shpChk
.Name = SC_CHK_PREFIX & Replace$(SubcategoryCell.Address, "$", "")
With .OLEFormat.Object
.Caption = ""
.Left = shpFrame.Left + 2!
.Top = shpFrame.Top + (shpFrame.Height - SC_CHK_WIDTH) / 2!
.Width = SC_CHK_WIDTH
.Height = SC_CHK_HEIGHT
End With
.OnAction = SC_MODULE_NAME & ".SubcategoryCheckBox_Click"
End With
Call RefreshSubcategoryCheckBox(shpChk.OLEFormat.Object)
End With
CreateSubcategory = True
End Function