I want to manage the Excel Styles in a more flexible way with bulk actions and at the same time improve my newly acquired OOP concepts.
Objectives:
Load the current Styles list (name and type=builtin or custom) in an Excel Structured Table (ListObject)
Allow users to:
Delete
Duplicate (create a new style based on another)
Replace (one style with another)
Main events:
1) Press "Load" button -> Load the workbook (thisworkbook) styles list into the Excel structured table
2) Press "Process" button -> Review each cell of the Source column in the Excel Table and run the selected action
Actions:
When user selects "Delete" -> The Excel Style based on the source column will be deleted
When user selects "Duplicate" -> A new Excel Style should be created with the name defined in the table column "Duplicated new style name | replace with"
When user selects "Replace" -> All instances where the Style is found in the workbook should be replaced with the one defined in the table column "Duplicated new style name | replace with"
Question: How can I structure this classes to add more Actions based on Composition?
Question: Would the Factory Pattern help to make this classes easier to maintain?
Maybe this is an overkill the best way to manage styles, but and I want to do it as a proof of concept too and to learn more about OOP.
Any help reviewing the code I'd appreciate.
Module: mStyles
'@Folder("Styles")
Option Explicit
Sub LoadStyles()
Dim myStyles As cStyles
Set myStyles = New cStyles
myStyles.LoadToTable
End Sub
Sub ProcessStyles()
Dim myStyles As cStyles
Set myStyles = New cStyles
myStyles.LoadFromTable
myStyles.ProcessStyles
myStyles.LoadToTable
End Sub
Class: cStyle
'@Folder("Styles")
Option Explicit
Private Type TStyle
Style As Style
Name As String
Action As String
Target As String
Exists As Boolean
End Type
Private this As TStyle
Public Property Let Name(value As String)
this.Name = value
End Property
Public Property Get Name() As String
Name = this.Name
End Property
Public Property Let Action(value As String)
this.Action = value
End Property
Public Property Get Action() As String
Action = this.Action
End Property
Public Property Let Target(value As String)
this.Target = value
End Property
Public Property Get Target() As String
Target = this.Target
End Property
Public Property Set Style(ByRef Style As Style)
Set this.Style = Style
End Property
Public Property Get Style() As Style
Set Style = this.Style
End Property
Public Sub Init(Name, Action, Target)
this.Name = Name
this.Action = Action
this.Target = Target
If Exists Then
Set this.Style = ThisWorkbook.Styles(this.Name)
End If
End Sub
Public Function Exists() As Boolean
' Returns TRUE if the named style exists in the target workbook.
On Error Resume Next
Exists = Len(ThisWorkbook.Styles(this.Name).Name) > 0
On Error GoTo 0
End Function
Public Function Duplicate() As Style
Dim styleCell As Range
Dim newName As String
Set styleCell = MStyles.Range("E1")
styleCell.Style = this.Name
newName = this.Target
Set Duplicate = ThisWorkbook.Styles.Add(newName, styleCell)
styleCell.Clear
End Function
Public Sub Delete()
If Exists Then this.Style.Delete
End Sub
Public Sub Replace()
Dim evalCell As Range
Dim newStyle As Style
Dim replaceSheet As Worksheet
Set newStyle = ThisWorkbook.Styles(this.Target)
For Each replaceSheet In ThisWorkbook.Worksheets
For Each evalCell In replaceSheet.UsedRange.Cells
If evalCell.Style = this.Style And evalCell.MergeCells = False Then evalCell.Style = newStyle
Next evalCell
Next replaceSheet
End Sub
Class: cStyles
'@Folder("Styles")
Option Explicit
Private Type TStyles
Styles As Collection
End Type
Private this As TStyles
Private Sub Class_Initialize()
Set this.Styles = New Collection
End Sub
Private Sub Class_Terminate()
Set this.Styles = Nothing
End Sub
Public Sub Add(obj As cStyle)
this.Styles.Add obj
End Sub
Public Sub Remove(Index As Variant)
this.Styles.Remove Index
End Sub
Public Property Get Item(Index As Variant) As cStyle
Set Item = this.Styles.Item(Index)
End Property
Property Get Count() As Long
Count = this.Styles.Count
End Property
Public Sub Clear()
Set this.Styles = New Collection
End Sub
Public Sub LoadToTable()
Dim stylesTable As ListObject
Dim curStyle As Style
Dim tempStyleInfo() As Variant
Dim counter As Integer
Dim counterStyles As Integer
counterStyles = ThisWorkbook.Styles.Count
ReDim tempStyleInfo(counterStyles, 3)
Set stylesTable = MStyles.ListObjects("TableStyles")
If Not stylesTable.DataBodyRange Is Nothing Then stylesTable.DataBodyRange.Delete
For Each curStyle In ThisWorkbook.Styles
tempStyleInfo(counter, 0) = curStyle.Name
tempStyleInfo(counter, 1) = IIf(curStyle.BuiltIn, "BuiltIn", "Custom")
counter = counter + 1
Next curStyle
stylesTable.Resize stylesTable.Range.Resize(RowSize:=UBound(tempStyleInfo, 1))
stylesTable.DataBodyRange = tempStyleInfo
End Sub
Public Sub LoadFromTable()
Dim stylesTable As ListObject
Dim styleCell As cStyle
Dim cellStyle As Range
Set stylesTable = MStyles.ListObjects("TableStyles")
For Each cellStyle In stylesTable.DataBodyRange.Columns(1).Cells
If cellStyle.Offset(ColumnOffset:=2) <> "" Then
Set styleCell = New cStyle
styleCell.Init cellStyle.Value2, cellStyle.Offset(ColumnOffset:=2).Value2, cellStyle.Offset(ColumnOffset:=3).Value2
this.Styles.Add styleCell
End If
Next cellStyle
End Sub
Public Sub ProcessStyles()
Dim styleCell As cStyle
For Each styleCell In this.Styles
Select Case styleCell.Action
Case "Delete"
styleCell.Delete
Case "Duplicate"
styleCell.Duplicate
Case "Replace"
styleCell.Replace
End Select
Next styleCell
End Sub