5
\$\begingroup\$

This is a follow up to this question

Code incorporates Mathieu's comments and it works. As some parts of the review left some code to my knowledge, I ask for another review to see if I implemented them correctly.

Objectives:

  • Load the current Styles list (name and type=builtin or custom) in an Excel Structured Table (ListObject)

  • Allow users to:

    1. Delete

    2. Duplicate (create a new style based on another)

    3. Replace (one style with another)


Main suggestions from previous review:

  • Apply naming conventions

  • Add factory method

  • Add Actions by composition


Note: My current level couldn't understand well how to apply the dependency injection concept


GUI:

enter image description here


Module: Macros

'@Folder("Styles")
Option Explicit

Public Sub LoadStyles()

    Dim myStyleProcessor As StyleProcessor

    Set myStyleProcessor = New StyleProcessor

    myStyleProcessor.LoadToTable

End Sub

Public Sub ProcessStyles()

    Dim myStyleProcessor As StyleProcessor

    Set myStyleProcessor = New StyleProcessor

    myStyleProcessor.LoadFromTable
    myStyleProcessor.Process
    myStyleProcessor.LoadToTable

End Sub

Class: StyleInfo

'@Folder("Styles")
'@PredeclaredID
Option Explicit

Public Enum Action
    DeleteStyle
    DuplicateStyle
    ReeplaceStyle
    RenameStyle
End Enum

Private Type TStyleInfo
    Style As Style
    Name As String
    Action As String
    Target As String
    Exists As Boolean
End Type

Private this As TStyleInfo

Public Property Let Name(ByVal value As String)
    this.Name = value
End Property

Public Property Get Name() As String
    Name = this.Name
End Property

Public Property Let Action(ByVal value As String)
    this.Action = value
End Property

Public Property Get Action() As String
    Action = this.Action
End Property

Public Property Let Target(ByVal value As String)
    this.Target = value
End Property

Public Property Get Target() As String
    Target = this.Target
End Property

Public Property Set Style(ByVal Style As Style)
    Set this.Style = Style
End Property

Public Property Get Style() As Style
    Set Style = this.Style
End Property

Public Property Get Self() As StyleInfo
    Set Self = Me
End Property

Public Function Create(ByVal Name As String, ByVal Action As String, ByVal Target As String) As StyleInfo
    With New StyleInfo
        .Name = Name
        .Action = Action
        .Target = Target
        If Exists(Name) Then
           Set .Style = ThisWorkbook.Styles(Name)
        End If
        Set Create = .Self
    End With
End Function

Public Function Exists(ByVal Name As String) As Boolean
    ' Returns TRUE if the named style exists in the target workbook.
    On Error Resume Next
    Exists = Len(ThisWorkbook.Styles(Name).Name) > 0
    On Error GoTo 0

End Function

Class: StyleProcessor

'@Folder("Styles")
Option Explicit

Private infos As Collection
Private StyleActions As Collection

Private Sub Class_Initialize()
    Set infos = New Collection
    Set StyleActions = New Collection
    StyleActions.Add New StyleActionDelete, "Delete"
    StyleActions.Add New StyleActionDuplicate, "Duplicate"
    StyleActions.Add New StyleActionReplace, "Replace"
End Sub

Private Sub Class_Terminate()
    Set infos = Nothing
End Sub

'TODO Public Sub Add(obj As StyleInfo) : infos.Add obj : End Sub
'TODO Public Sub Remove(Index As Variant) : infos.Remove Index : End Sub

'@DefaultMember
Public Property Get Item(ByVal Index As Variant) As StyleInfo
    Set Item = infos.Item(Index)
End Property

Public Property Get Count() As Long
    Count = infos.Count
End Property


Public Sub LoadToTable()

    Dim stylesTable As ListObject
    Dim currentStyle As Style

    Dim tempStyleInfo() As Variant
    Dim counter As Long
    Dim counterStyles As Long

    counter = 0

    counterStyles = ThisWorkbook.Styles.Count
    ReDim tempStyleInfo(counterStyles + 1, 3)


    Set stylesTable = MStyles.ListObjects("TableStyles")

    If Not stylesTable.DataBodyRange Is Nothing Then stylesTable.DataBodyRange.Delete

    For Each currentStyle In ThisWorkbook.Styles

        tempStyleInfo(counter, 0) = currentStyle.Name
        tempStyleInfo(counter, 1) = IIf(currentStyle.BuiltIn, "BuiltIn", "Custom")
        counter = counter + 1

    Next currentStyle

    stylesTable.Resize stylesTable.Range.Resize(RowSize:=UBound(tempStyleInfo, 1))

    stylesTable.DataBodyRange = tempStyleInfo

End Sub

Public Sub LoadFromTable()

    Dim stylesTable As ListObject
    Dim styleCell As Range

    Set stylesTable = MStyles.ListObjects("TableStyles")

    For Each styleCell In stylesTable.DataBodyRange.Columns(1).Cells

        If styleCell.Offset(ColumnOffset:=2) <> vbNullString Then

            infos.Add StyleInfo.Create(styleCell.Value2, styleCell.Offset(ColumnOffset:=2).Value2, styleCell.Offset(ColumnOffset:=3).Value2)

        End If

    Next styleCell


End Sub

Public Sub Process()

    Dim info As StyleInfo
    For Each info In infos
        Dim strategy As IStyleInfoAction
        Set strategy = StyleActions(info.Action)
        strategy.Run info
    Next

End Sub

Class (Interface): IStyleInfoAction

'@Folder("Styles")
Option Explicit

Public Sub Run(ByVal newStyleInfo As StyleInfo)
End Sub

Class: StyleActionDelete

'@Folder("Styles.Action")
Option Explicit

Implements IStyleInfoAction

Private Sub IStyleInfoAction_Run(ByVal newStyleInfo As StyleInfo)
    If Not newStyleInfo.Style Is Nothing Then newStyleInfo.Style.Delete
End Sub

Class: StyleActionDuplicate

'@Folder("Styles.Action")
Option Explicit

Implements IStyleInfoAction

Private Sub IStyleInfoAction_Run(ByVal newStyleInfo As StyleInfo)
    Dim styleCell As Range
    Dim newName As String

    Set styleCell = MStyles.Range("E1")

    styleCell.Style = newStyleInfo.Name

    newName = newStyleInfo.Target

    ThisWorkbook.Styles.Add newName, styleCell

    styleCell.Clear

End Sub

Class: StyleActionReplace

'@Folder("Styles.Action")
Option Explicit

Implements IStyleInfoAction

Private Sub IStyleInfoAction_Run(ByVal newStyleInfo As StyleInfo)

    Dim evalCell As Range
    Dim newStyle As Style
    Dim replaceSheet As Worksheet

    Set newStyle = ThisWorkbook.Styles(newStyleInfo.Target)

    For Each replaceSheet In ThisWorkbook.Worksheets

        For Each evalCell In replaceSheet.UsedRange.Cells

            If evalCell.Style = newStyleInfo.Style And evalCell.MergeCells = False Then evalCell.Style = newStyle

        Next evalCell

    Next replaceSheet

End Sub

Link to current file

\$\endgroup\$
8
  • 2
    \$\begingroup\$ Well done! Dependency Injection (DI) would be e.g. treating the collection of IStyleInfoAction objects as a dependency, and providing them to the processor class via a Property Set member, a factory method, or as an argument to the Process method. That way adding new actions doesn't require modifying the processor class. If you inject all the dependencies of your class, you're able to write code that tests its functionality (and injects test-controlled dependencies) - unit tests. \$\endgroup\$ Oct 30, 2019 at 0:34
  • 2
    \$\begingroup\$ Actually the only DI techniques available to VBA are property injection and method injection; the normally preferred constructor injection is ruled out, for lack of constructors in the language ...but property injection via a factory method gets pretty close - see here and here =) \$\endgroup\$ Oct 30, 2019 at 0:54
  • \$\begingroup\$ @MathieuGuindon Thank you for all the insights. For DI is it good practice if I place a Private Sub InitializeStyleProcessor(ByVal processor As StyleProcessor) where I add the StyleActions and use processor.Create styleActions in the Macros module? \$\endgroup\$ Oct 30, 2019 at 2:43
  • 1
    \$\begingroup\$ My previous question was based on your post here \$\endgroup\$ Oct 30, 2019 at 2:54
  • \$\begingroup\$ Another compelling reason to union the ranges before changing the Styles in in the case of Swapping Styles. Say for instance you wanted to change all the Accent1 to Accent 2 and all the Accent2 to Accent1. This will not be possible unless you create all the unions before you change the styles. \$\endgroup\$
    – TinMan
    Nov 1, 2019 at 2:38

1 Answer 1

1
\$\begingroup\$

Over all the code is really good but LoadToTable() could be tweaked.

Public Sub LoadToTable()

1     Dim stylesTable As ListObject
2     Dim currentStyle As Style

3     Dim tempStyleInfo() As Variant
4     Dim counter As Long
5     Dim counterStyles As Long

6     counter = 0

7     counterStyles = ThisWorkbook.Styles.Count
8     ReDim tempStyleInfo(counterStyles + 1, 3)


9     Set stylesTable = MStyles.ListObjects("TableStyles")

10     If Not stylesTable.DataBodyRange Is Nothing Then stylesTable.DataBodyRange.Delete

11     For Each currentStyle In ThisWorkbook.Styles

12         tempStyleInfo(counter, 0) = currentStyle.name
13         tempStyleInfo(counter, 1) = IIf(currentStyle.BuiltIn, "BuiltIn", "Custom")
14         counter = counter + 1

15     Next currentStyle

16     stylesTable.Resize stylesTable.Range.Resize(RowSize:=UBound(tempStyleInfo, 1))

17     If stylesTable.DataBodyRange Is Nothing Then stylesTable.ListRows.Add

18     stylesTable.DataBodyRange = tempStyleInfo

   End Sub

Line 6 counter = 0

This is the first time counter is used there is no reason to initiate a variable to its default value.

Line 7 counterStyles = ThisWorkbook.Styles.Count

counterStyles does little to add to the readability of the code. It's clear what ThisWorkbook.Styles.Count does counterStyles is just adding 2 extra lines to the subroutines body.

Line 8 ReDim tempStyleInfo(counterStyles + 1, 3) counterStyles + 1 is wrong. It causing tempStyleInfo to be created with 2 extra rows.

I prefer to work with 1 based arrays when writing data to a range. Using

 ReDim tempStyleInfo(1 to counterStyles, 1 to 4)

Here is the correct declaration for the 0 based array:

 ReDim tempStyleInfo(0 to counterStyles - 1, 0 to 3)

Although not necessary it is recommended to include the array base size when declaring an array.

Line 9 Set stylesTable = MStyles.ListObjects("TableStyles")

Consider passing in thestylesTable as a parameter of the Create method.

9     Set stylesTable = MStyles.ListObjects("TableStyles")
10     If Not stylesTable.DataBodyRange Is Nothing Then 

Lines 9 and 10 should appear after the Line 15. There is no reason to modify the table before the data is compiled. As a rule, I gather the data in a separate sub or function. This allows me to test the two tasks independently.

Line 16 stylesTable.Resize stylesTable.Range.Resize(RowSize:=UBound(tempStyleInfo, 1))

Line 17 If stylesTable.DataBodyRange Is Nothing Then stylesTable.ListRows.Add

Line 17 never triggers because Line 16 already added the correct number of rows.

Line 11 For Each currentStyle In ThisWorkbook.Styles

Using ThisWorkbook severely limits the usefulness of the code. It would be far better to set the target workbook in the Create method. Other classes are also limited by ThisWorkbook. I would set a reference to the parent StyleProcessor class in these class's Create methods so you can reference the parent's target workbook (e.g. Parent.TargetWorkbook).

Refactored Code

Public Sub LoadToTable()
    Dim Values
    Values = getStyleInfo()

    If Not stylesTable.DataBodyRange Is Nothing Then stylesTable.DataBodyRange.Delete
    stylesTable.ListRows.Add
    stylesTable.DataBodyRange.Resize(UBound(Values, 1)) = Values

End Sub

Private Function getStyleInfo()
    Dim Results
    ReDim Results(1 To TargetWorkbook.Styles.Count, 1 To stylesTable.ListColumns.Count)

    Dim n As Long
    Dim currentStyle As Style
    For Each currentStyle In TargetWorkbook.Styles
        n = n + 1
        Results(n, 1) = currentStyle.name
        Results(n, 2) = IIf(currentStyle.BuiltIn, "BuiltIn", "Custom")
     Next

     getStyleInfo = Results
End Function

Application.ScreenUpdating should be turned off when updating styles. You should also test changing name of individual cells styles versus Union the range for large number of cells.

\$\endgroup\$
4
  • \$\begingroup\$ This is awesome and very illustrative feedback. Thank you! Could you elaborate more on this suggestion: "You should also test changing name of individual cells styles versus Union the range for large number of cells" ? \$\endgroup\$ Oct 31, 2019 at 12:09
  • \$\begingroup\$ @RicardoDiaz Here is my answer to Brute force looping & formatting Or Create Union range & Format? Which is efficient and when?. The question does a good job of explaining the performances of formatting individual versus groups of cells. \$\endgroup\$
    – TinMan
    Oct 31, 2019 at 13:53
  • \$\begingroup\$ @RicardoDiaz Another thing that I forgot to mention, you should add a Restore Default Styles button. \$\endgroup\$
    – TinMan
    Oct 31, 2019 at 13:55
  • \$\begingroup\$ Thank you. You 're right about the restore button. Checking the link right now. \$\endgroup\$ Oct 31, 2019 at 14:19

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.