2
\$\begingroup\$

The class assigns various strings to the build number. So the build might look like 3.4.5.1 which would be of the format version.major.minor.patch. When picking set codever button, it assigns (or replaces) the current MsCodeVer with the new string. so basically, I have a global var MsCodeVer that is used in every procedure in the workbook (if so desired) to help in tracking when I update a proc or module. I have other addins that use these global vars that can update libraries automatically. So, for me, this is helpful in tracking the development of code.

This is just my second class (but really the first class I have written). I would like to know if I got the 'class' part right?

To see it in action (with the user forms and modules), is there a place that I can upload the entire workbook to for further testing?

Below is CCodeVer class

 '@IgnoreModule ArgumentWithIncompatibleObjectType, UnassignedVariableUsage, VariableNotAssigned, ConstantNotUsed, ProcedureNotUsed
 Option Explicit
 Private m_Patch As String
 Private m_Minor As String
 Private m_Major As String
 Private m_Version As String
 Private m_CodeVer As String
 Private Const MSCODEVERMOD As String = "3.0.4"
 '@Folder("Commands")
 Private Sub Class_Initialize()
 MsCodeVer = "3.0.4.1"
 m_Patch = "0"
 m_Minor = "0"
 m_Major = "0"
 m_Version = "0"
 m_CodeVer = m_Version & SEP & m_Major & SEP & m_Minor & SEP & m_Patch
 
 End Sub
 Private Sub Class_Terminate()
 MsCodeVer = "3.0.4.1"
 'do i really need to do anything here?
 
 End Sub
 Public Property Get CodeVerS() As String: Version = m_CodeVer: End Property
 Public Property Let CodeVerS(ByVal CV As String): m_Version = CV: End Property
 Public Property Get Major() As String: Major = m_Major: End Property
 Public Property Let Major(ByVal Maj As String): m_Major = Maj: End Property
 Public Property Get Minor() As String: Minor = m_Minor: End Property
 Public Property Let Minor(ByVal Min As String): m_Minor = Min: End Property
 Public Property Get Patch() As String: Patch = m_Patch: End Property
 Public Property Let Patch(ByVal Pat As String): m_Patch = Pat: End Property
 Public Property Get Version() As String: Version = m_Version: End Property
 Public Property Let Version(ByVal Ver As String): m_Version = Ver: End Property
 Public Sub AddCodeVer(ByVal Workbook As String, ByVal Module As String, ByVal Procedure As String, ByVal CodeVerString As String)
 MsCodeVer = "3.0.4.1"
 Dim VbProj As VBIDE.VBProject
 Dim VbComp As VBIDE.VBComponent
 Dim CodeMod As VBIDE.CodeModule
 Dim LineNum As Long
 Dim ProcKind As VBIDE.vbext_ProcKind
 Dim StartLine As Long
 Dim EndLine As Long
 Dim CountOfLine As Long
 Dim Ai As AddIn
 Dim Wb As Workbook
 Dim Answer As VbMsgBoxResult
 
 If CodeVerString = SNOVC Then Exit Sub
 On Error GoTo errHandler
 
 'check for empty workbook combobox which means
 'all open, unprotected workbooks and addins
 If MobjUserForm.cbo_Workbook.Value = vbNullString Then
 Answer = MsgBox("This will add the MsCodeVer string to all open" & vbCr & _
 "and unprotected workbooks. This could take some time. Ok to continue? ", _
 vbYesNo, "Process Workbooks?")
 If Answer = vbNo Then Exit Sub
 For Each Wb In Workbooks
 If Not Wb.ProtectWindows Or _
 Not Wb.ProtectStructure Or _
 Not Wb.Name = ThisWorkbook.Name Then
 Workbook = Wb.Name
 Set VbProj = Wb.VBProject
 For Each VbComp In VbProj.VBComponents
 Module = VbComp.Name
 Set CodeMod = VbComp.CodeModule
 With CodeMod
 LineNum = .CountOfDeclarationLines + 1
 Do Until LineNum >= .CountOfLines
 Procedure = .ProcOfLine(LineNum, ProcKind)
 Select Case ProcKind
 Case vbext_pk_Get
 Procedure = Procedure & " (Get)"
 Case vbext_pk_Let
 Procedure = Procedure & " (Let)"
 Case vbext_pk_Set
 Procedure = Procedure & " (Set)"
 End Select
 If ProcKind = vbext_pk_Proc Then
 StartLine = .ProcBodyLine(Procedure, vbext_pk_Proc)
 EndLine = StartLine - 2 + .ProcCountLines(Procedure, vbext_pk_Proc)
 Call SearchModule(Workbook, Module, Procedure, CodeVerString, CodeMod, StartLine, EndLine)
 End If
 LineNum = .ProcStartLine(Split(Procedure, " (")(0), ProcKind) + _
 .ProcCountLines(Split(Procedure, " (")(0), ProcKind) + 1
 Loop
 End With
 Next VbComp
 End If
 Next Wb
 Answer = MsgBox("This will add the MsCodeVer string to all open" & vbCr & _
 "installed and unprotected addins. This could take some time. Ok to continue? ", _
 vbYesNo, "Process AddIns?")
 If Answer = vbNo Then Exit Sub
 For Each Ai In Application.VBE.AddIns
 If Not Ai.Name = ThisWorkbook.Name Or _
 Not Right(Ai.Name, 3) = "XLL" Or _
 Ai.Installed Or _
 Not IsProtectedAi(Ai) Then
 Workbook = Ai.Name
 Set VbProj = Workbooks(Ai.Name).VBProject
 For Each VbComp In VbProj.VBComponents
 Module = VbComp.Name
 Set CodeMod = VbComp.CodeModule
 With CodeMod
 LineNum = .CountOfDeclarationLines + 1
 Do Until LineNum >= .CountOfLines
 Procedure = .ProcOfLine(LineNum, ProcKind)
 Select Case ProcKind
 Case vbext_pk_Get
 Procedure = Procedure & " (Get)"
 Case vbext_pk_Let
 Procedure = Procedure & " (Let)"
 Case vbext_pk_Set
 Procedure = Procedure & " (Set)"
 End Select
 If ProcKind = vbext_pk_Proc Then
 StartLine = .ProcBodyLine(Procedure, vbext_pk_Proc)
 EndLine = StartLine - 2 + .ProcCountLines(Procedure, vbext_pk_Proc)
 Call SearchModule(Workbook, Module, Procedure, CodeVerString, CodeMod, StartLine, EndLine)
 End If
 LineNum = .ProcStartLine(Split(Procedure, " (")(0), ProcKind) + _
 .ProcCountLines(Split(Procedure, " (")(0), ProcKind) + 1
 Loop
 End With
 Next VbComp
 End If
 Next Ai
 'check for empty module combobox
 'which means all modules in selected workbook
 ElseIf MobjUserForm.cbo_Module.Value = vbNullString Then
 Workbook = MobjUserForm.cbo_Workbook.Value
 Set VbProj = Workbooks(MobjUserForm.cbo_Workbook.Value).VBProject
 For Each VbComp In VbProj.VBComponents
 Module = VbComp.Name
 Set CodeMod = VbComp.CodeModule
 With CodeMod
 LineNum = .CountOfDeclarationLines + 1
 Do Until LineNum >= .CountOfLines
 Procedure = .ProcOfLine(LineNum, ProcKind)
 Select Case ProcKind
 Case vbext_pk_Get
 Procedure = Procedure & " (Get)"
 Case vbext_pk_Let
 Procedure = Procedure & " (Let)"
 Case vbext_pk_Set
 Procedure = Procedure & " (Set)"
 End Select
 If ProcKind = vbext_pk_Proc Then
 StartLine = .ProcBodyLine(Procedure, vbext_pk_Proc)
 EndLine = StartLine - 2 + .ProcCountLines(Procedure, vbext_pk_Proc)
 Call SearchModule(Workbook, Module, Procedure, CodeVerString, CodeMod, StartLine, EndLine)
 End If
 LineNum = .ProcStartLine(Split(Procedure, " (")(0), ProcKind) + _
 .ProcCountLines(Split(Procedure, " (")(0), ProcKind) + 1
 Loop
 End With
 Next VbComp
 'check for empty procedure combobox
 'which means all procedures in the selected module
 ElseIf MobjUserForm.cbo_Procedure.Value = vbNullString Then
 Workbook = MobjUserForm.cbo_Workbook.Value
 Module = MobjUserForm.cbo_Module.Value
 Set CodeMod = Workbooks(Workbook).VBProject.VBComponents(Module).CodeModule
 With CodeMod
 LineNum = .CountOfDeclarationLines + 1
 Do Until LineNum >= .CountOfLines
 Procedure = .ProcOfLine(LineNum, ProcKind)
 Select Case ProcKind
 Case vbext_pk_Get
 Procedure = Procedure & " (Get)"
 Case vbext_pk_Let
 Procedure = Procedure & " (Let)"
 Case vbext_pk_Set
 Procedure = Procedure & " (Set)"
 End Select
 If ProcKind = vbext_pk_Proc Then
 StartLine = .ProcBodyLine(Procedure, vbext_pk_Proc)
 EndLine = StartLine - 2 + .ProcCountLines(Procedure, vbext_pk_Proc)
 Call SearchModule(Workbook, Module, Procedure, CodeVerString, CodeMod, StartLine, EndLine)
 End If
 LineNum = .ProcStartLine(Split(Procedure, " (")(0), ProcKind) + _
 .ProcCountLines(Split(Procedure, " (")(0), ProcKind) + 1
 Loop
 End With
 Else
 Set CodeMod = Workbooks(Workbook).VBProject.VBComponents(Module).CodeModule
 With CodeMod
 StartLine = .ProcBodyLine(Procedure, vbext_pk_Proc)
 EndLine = StartLine - 2 + .ProcCountLines(Procedure, vbext_pk_Proc)
 Call SearchModule(Workbook, Module, Procedure, CodeVerString, CodeMod, StartLine, EndLine)
 End With
 End If
 
 Exit Sub
 
 errHandler:
 
 MsgBox ("CCodeVer " & Err.Number & " " & Err.Description)
 Stop
 Resume
 
 End Sub
 Public Sub AddCodeVerVar(ByVal Workbook As String, Optional bDelete As Boolean = False)
 
 Dim VbComp As VBComponent
 Dim Counter As Long
 Dim TrimLines As String
 Dim Found As Boolean
 
 For Each VbComp In Workbooks(Workbook).VBProject.VBComponents
 With VbComp.CodeModule
 For Counter = 1 To .CountOfDeclarationLines
 TrimLines = Trim(.Lines(Counter, 1))
 If TrimLines Like "Public MsCodeVer as String*" Then
 Found = True
 If bDelete Then VbComp.CodeModule.DeleteLines (Counter)
 Exit Sub
 End If
 Next Counter
 If Not Found Then
 If Not ModExists(Workbook, "MDeclare") Then
 Set VbComp = Workbooks(Workbook).VBProject.VBComponents.Add(vbext_ct_StdModule)
 With VbComp
 .Name = "MDeclare"
 .CodeModule.InsertLines (.CodeModule.CountOfDeclarationLines + 1), "Public MsCodeVer as String"
 End With
 End If
 Exit For
 Else
 Set VbComp = Workbooks(Workbook).VBProject.VBComponents("MDeclare")
 VbComp.CodeModule.InsertLines (VbComp.CodeModule.CountOfDeclarationLines + 1), "Public MsCodeVer as String"
 End If
 End With
 Next VbComp
 
 End Sub
 Public Sub AddCodeVerVersionConst(ByVal Workbook As String, ByVal Version As String, Optional bDelete As Boolean = False)
 
 Dim VbComp As VBComponent
 Dim Counter As Long
 Dim TrimLines As String
 Dim Found As Boolean
 
 For Each VbComp In Workbooks(Workbook).VBProject.VBComponents
 If VbComp.Name = "MDeclare" Then
 With VbComp.CodeModule
 For Counter = 1 To .CountOfDeclarationLines
 TrimLines = Trim(.Lines(Counter, 1))
 If TrimLines Like "Public Const MSVERSION As String = *" Then
 Found = True
 If bDelete Then
 VbComp.CodeModule.DeleteLines Counter
 Else
 VbComp.CodeModule.ReplaceLine Counter, "Public Const MSVERSION As String = " & Chr(34) & Version & Chr(34)
 End If
 Exit Sub
 End If
 Next Counter
 End With
 End If
 Next VbComp
 If Not Found Then
 If Not ModExists(Workbook, "MDeclare") Then
 Set VbComp = Workbooks(Workbook).VBProject.VBComponents.Add(vbext_ct_StdModule)
 With VbComp
 .Name = "MDeclare"
 .CodeModule.InsertLines (.CodeModule.CountOfDeclarationLines + 1), "Public Const MSVERSION As String = " & Chr(34) & Version & Chr(34)
 End With
 End If
 Else
 Set VbComp = Workbooks(Workbook).VBProject.VBComponents("MDeclare")
 VbComp.CodeModule.InsertLines (VbComp.CodeModule.CountOfDeclarationLines + 1), "Public Const MSVERSION As String = " & Chr(34) & Version & Chr(34)
 End If
 End Sub
 Public Function AddMajor(Major As Long) As String
 
 MsCodeVer = "3.0.4.1"
 Dim CvSplit As Variant
 
 CvSplit = Split(MobjUserForm.txt_VersionControlString.Value, ".")
 
 m_Version = CvSplit(0)
 m_Major = CvSplit(1)
 m_Minor = CvSplit(2)
 m_Patch = CvSplit(3)
 
 AddMajor = Format(CLng(m_Major) + Major, "0")
 
 If MobjUserForm.chk_ShowLeadingZeros.Value = True Then
 AddMajor = Format(CLng(m_Major) + Major, "0000")
 Else
 AddMajor = Format(CLng(m_Major) + Major, "0")
 End If
 
 If AddMajor > 9999 Then
 AddMajor = "0"
 m_Major = "0"
 m_Version = CStr(CLng(m_Version + 1))
 End If
 If CLng(m_Version) >= 999999 Then
 MsgBox ("Resetting to base string")
 m_Version = "0"
 m_Major = "0"
 m_Minor = "0"
 m_Patch = "0"
 End If
 
 m_CodeVer = m_Version & SEP & AddMajor & SEP & m_Minor & SEP & m_Patch
 
 Application.EnableEvents = False
 MobjUserForm.txt_VersionControlString = m_CodeVer
 Application.EnableEvents = True
 
 End Function
 Public Function AddMinor(Minor As Long) As String
 MsCodeVer = "3.0.4.1"
 Dim CvSplit As Variant
 
 CvSplit = Split(MobjUserForm.txt_VersionControlString.Value, ".")
 
 m_Version = CvSplit(0)
 m_Major = CvSplit(1)
 m_Minor = CvSplit(2)
 m_Patch = CvSplit(3)
 
 AddMinor = Format(CLng(m_Minor) + Minor, "0")
 
 If MobjUserForm.chk_ShowLeadingZeros.Value = True Then
 AddMinor = Format(CLng(m_Minor) + Minor, "0000")
 Else
 AddMinor = Format(CLng(m_Minor) + Minor, "0")
 End If
 
 If AddMinor > 9999 Then
 AddMinor = "0"
 m_Minor = "0"
 m_Major = CStr(CLng(m_Major + 1))
 End If
 If CLng(m_Major) > 9999 Then
 m_Major = "0"
 m_Version = CStr(CLng(m_Version + 1))
 End If
 If CLng(m_Version) >= 999999 Then
 MsgBox ("Resetting to base string")
 m_Version = "0"
 If CvSplit(1) = "9999" Then m_Major = "0"
 If CvSplit(2) = "9999" Then m_Minor = "0"
 If CvSplit(3) = "9999" Then m_Patch = "0"
 End If
 
 m_CodeVer = m_Version & SEP & m_Major & SEP & AddMinor & SEP & m_Patch
 
 Application.EnableEvents = False
 MobjUserForm.txt_VersionControlString = m_CodeVer
 Application.EnableEvents = True
 
 End Function
 Public Function AddPatch(Patch As Long) As String
 MsCodeVer = "3.0.4.1"
 Dim CvSplit As Variant
 
 CvSplit = Split(MobjUserForm.txt_VersionControlString.Value, ".")
 
 m_Version = CvSplit(0)
 m_Major = CvSplit(1)
 m_Minor = CvSplit(2)
 m_Patch = CvSplit(3)
 
 AddPatch = Format(CLng(m_Patch) + Patch, "0")
 
 If MobjUserForm.chk_ShowLeadingZeros.Value = True Then
 AddPatch = Format(CLng(m_Patch) + Patch, "0000")
 Else
 AddPatch = Format(CLng(m_Patch) + Patch, "0")
 End If
 If AddPatch > 9999 Then
 AddPatch = 0
 m_Patch = "0"
 m_Minor = CStr(CLng(m_Minor + 1))
 End If
 If CLng(m_Minor) > 9999 Then
 m_Minor = "0"
 m_Major = CStr(CLng(m_Major + 1))
 End If
 If CLng(m_Major) > 9999 Then
 m_Major = "0"
 m_Version = CStr(CLng(m_Version + 1))
 End If
 If CLng(m_Version) >= 999999 Then
 MsgBox ("Resetting to base string")
 m_Version = "0"
 If CvSplit(1) = "9999" Then m_Major = "0"
 If CvSplit(2) = "9999" Then m_Minor = "0"
 If CvSplit(3) = "9999" Then m_Patch = "0"
 End If
 m_CodeVer = m_Version & SEP & m_Major & SEP & m_Minor & SEP & AddPatch
 
 Application.EnableEvents = False
 MobjUserForm.txt_VersionControlString = m_CodeVer
 Application.EnableEvents = True
 
 End Function
 Public Function AddVersion(Version As Long) As String
 MsCodeVer = "3.0.4.1"
 Dim CvSplit As Variant
 
 CvSplit = Split(MobjUserForm.txt_VersionControlString.Value, ".")
 
 AddVersion = Format(CLng(CvSplit(0)) + Version, "0")
 
 m_Version = AddVersion
 m_Major = CvSplit(1)
 m_Minor = CvSplit(2)
 m_Patch = CvSplit(3)
 
 If AddVersion > 999999 Then
 AddVersion = "0"
 MsgBox ("Resetting to base string")
 m_Version = "0"
 If CvSplit(1) = "9999" Then m_Major = "0"
 If CvSplit(2) = "9999" Then m_Minor = "0"
 If CvSplit(3) = "9999" Then m_Patch = "0"
 End If
 
 If MobjUserForm.chk_UpdateVersion.Value = True Then
 Call AddCodeVerVersionConst(MobjUserForm.cbo_Workbook.Value, AddVersion)
 MobjUserForm.chk_UpdateVersion.Value = False
 End If
 
 m_CodeVer = AddVersion & SEP & m_Major & SEP & m_Minor & SEP & m_Patch
 
 Application.EnableEvents = False
 MobjUserForm.txt_VersionControlString = m_CodeVer
 Application.EnableEvents = True
 
 End Function
 Function FindLastParenthesis(ByVal Workbook As String, ByVal Module As String, ByVal Procedure As String) As Long
 MsCodeVer = "3.0.4.1"
 Dim CountOfLines As Long
 Dim EndLine As Long
 Dim StartLine As Long
 Dim TrimLines As String
 Dim CodMod As CodeModule
 Dim LeftCount As Long
 Dim RightCount As Long
 Dim InnerCount As Long
 
 Set CodMod = Workbooks(Workbook).VBProject.VBComponents(Module).CodeModule
 StartLine = GetProcInfo(Workbook, Module, Procedure, "StartLine")
 EndLine = GetProcInfo(Workbook, Module, Procedure, "EndLine")
 
 With CodMod
 For CountOfLines = StartLine To EndLine - 1
 TrimLines = Trim(.Lines(CountOfLines, 1))
 LeftCount = Len(TrimLines) - Len(Replace(TrimLines, "(", vbNullString))
 RightCount = Len(TrimLines) - Len(Replace(TrimLines, ")", vbNullString))
 If LeftCount = RightCount Then
 FindLastParenthesis = CountOfLines
 Exit Function
 End If
 If Right(TrimLines, 1) = ")" Then 'Or sTrimLines Like "*)*" Then
 FindLastParenthesis = CountOfLines
 Exit Function
 End If
 For InnerCount = CountOfLines To .CountOfLines 'skip to next line and look for ')'
 TrimLines = Trim(.Lines(InnerCount, 1))
 If TrimLines Like "*)*" Then
 FindLastParenthesis = InnerCount 'either this is plus one, or the above is wrong (no plus one)
 Exit Function
 End If
 Next InnerCount
 Next CountOfLines
 End With
 End Function
 Function GetProcCount(Workbook As String, Module As String) As Long
 Dim CodeMod As VBIDE.CodeModule
 Dim CodeVer As CCodeVer
 Dim LineNum As Long
 Dim ProcKind As VBIDE.vbext_ProcKind
 Dim ProcName As String
 Dim ProcCount As Long
 
 Set CodeVer = New CCodeVer
 Set CodeMod = Workbooks(Workbook).VBProject.VBComponents(Module).CodeModule
 
 With CodeMod
 LineNum = .CountOfDeclarationLines + 1
 Do Until LineNum >= .CountOfLines
 ProcName = .ProcOfLine(LineNum, ProcKind)
 If ProcKind = vbext_pk_Proc Then
 ProcCount = ProcCount + 1
 End If
 LineNum = .ProcStartLine(Split(ProcName, " (")(0), ProcKind) + _
 .ProcCountLines(Split(ProcName, " (")(0), ProcKind) + 1
 Loop
 End With
 
 GetProcCount = ProcCount
 
 End Function
 Function GetProcInfo(Workbook As String, Module As String, Procedure As String, sCommand As String) As Variant
 MsCodeVer = "3.0.4.1"
 Dim BodyCount As Long
 Dim EndProc As Long
 Dim Header As Long
 Dim ProcSize As Long
 Dim ProcStart As Long
 Dim StartLine As Long
 Dim ProcType As String
 Dim MyString As String
 Dim CodMod As CodeModule
 
 Set CodMod = Workbooks(Workbook).VBProject.VBComponents(Module).CodeModule
 With CodMod
 StartLine = .ProcBodyLine(Procedure, vbext_pk_Proc)
 ProcSize = .ProcCountLines(Procedure, vbext_pk_Proc) - .ProcBodyLine(Procedure, vbext_pk_Proc) + .ProcStartLine(Procedure, vbext_pk_Proc)
 Procedure = .ProcOfLine(StartLine, vbext_pk_Proc)
 ProcStart = .ProcStartLine(Procedure, vbext_pk_Proc)
 BodyCount = ProcSize - 2
 EndProc = StartLine + ProcSize - 1
 Header = StartLine - ProcStart
 ProcType = Split(.Lines(StartLine, 1), " " & Procedure)(0)
 MyString = MyString & "The procedure definition starts on line " & StartLine & vbCr
 MyString = MyString & "The total size of procedure inc definition and end command is " & ProcSize & vbCr
 MyString = MyString & "The procedure name is " & Procedure & vbCr
 MyString = MyString & "The start of the header or blank line is " & ProcStart & vbCr
 MyString = MyString & "The body line count is " & BodyCount & vbCr
 MyString = MyString & "The procedure ends on line " & EndProc & vbCr
 MyString = MyString & "The header and blank line count is " & Header & vbCr
 MyString = MyString & "The type of procedure is a " & ProcType
 'Debug.Print sString
 End With
 If sCommand = "StartLine" Then
 GetProcInfo = StartLine
 ElseIf sCommand = "EndLine" Then
 GetProcInfo = EndProc
 ElseIf sCommand = "BodyLength" Then
 GetProcInfo = BodyCount
 ElseIf sCommand = "ProcName" Then
 GetProcInfo = Procedure
 ElseIf sCommand = "ProcTotal" Then
 GetProcInfo = ProcSize
 ElseIf sCommand = "ProcType" Then
 GetProcInfo = ProcType
 ElseIf sCommand = "HeaderInfo" Then
 GetProcInfo = Header
 ElseIf sCommand = "HeaderStart" Then
 GetProcInfo = ProcStart
 ElseIf sCommand = "FullList" Then
 MsgBox MyString
 Else
 MsgBox ("Your Command argument is invalid. Only values that are acceptable are" & vbCr & _
 "StartLine, EndLine, BodyLength, ProcName, ProcTotal, ProcType, HeaderInfo, HeaderStart or FullList")
 End If
 End Function
 Public Function MinusMajor(Major As Long) As String
 MsCodeVer = "3.0.4.1"
 Dim CvSplit As Variant
 
 CvSplit = Split(MobjUserForm.txt_VersionControlString.Value, ".")
 
 MinusMajor = Format(CLng(CvSplit(1)) - Major, "0")
 If MobjUserForm.chk_ShowLeadingZeros.Value = True Then
 MinusMajor = Format(CLng(CvSplit(1)) - Major, "0000")
 If MinusMajor < 0 Then MinusMajor = "0000"
 Else
 MinusMajor = Format(CLng(CvSplit(1)) - Major, "0")
 If MinusMajor < 0 Then MinusMajor = "0"
 End If
 m_Version = CvSplit(0)
 'm_Major = CvSplit(1)
 m_Minor = CvSplit(2)
 m_Patch = CvSplit(3)
 
 m_CodeVer = m_Version & SEP & MinusMajor & SEP & m_Minor & SEP & m_Patch
 
 Application.EnableEvents = False
 MobjUserForm.txt_VersionControlString = m_CodeVer
 Application.EnableEvents = True
 
 End Function
 Public Function MinusMinor(Minor As Long) As String
 MsCodeVer = "3.0.4.1"
 Dim CvSplit As Variant
 
 CvSplit = Split(MobjUserForm.txt_VersionControlString.Value, ".")
 
 If MobjUserForm.chk_ShowLeadingZeros.Value = True Then
 MinusMinor = Format(CLng(CvSplit(2)) - Minor, "0000")
 If MinusMinor < 0 Then MinusMinor = "0000"
 Else
 MinusMinor = Format(CLng(CvSplit(2)) - Minor, "0")
 If MinusMinor < 0 Then MinusMinor = "0"
 End If
 
 m_Version = CvSplit(0)
 m_Major = CvSplit(1)
 'm_Minor = CvSplit(2)
 m_Patch = CvSplit(3)
 
 m_CodeVer = m_Version & SEP & m_Major & SEP & MinusMinor & SEP & m_Patch
 
 Application.EnableEvents = False
 MobjUserForm.txt_VersionControlString = m_CodeVer
 Application.EnableEvents = True
 
 End Function
 Public Function MinusPatch(Patch As Long) As String
 MsCodeVer = "3.0.4.1"
 Dim CvSplit As Variant
 
 CvSplit = Split(MobjUserForm.txt_VersionControlString.Value, ".")
 
 If MobjUserForm.chk_ShowLeadingZeros.Value = True Then
 MinusPatch = Format(CLng(CvSplit(3)) - Patch, "0000")
 If MinusPatch < 0 Then MinusPatch = "0000"
 Else
 MinusPatch = Format(CLng(CvSplit(3)) - Patch, "0")
 If MinusPatch < 0 Then MinusPatch = "0"
 End If
 
 m_Version = CvSplit(0)
 m_Major = CvSplit(1)
 m_Minor = CvSplit(2)
 'm_Patch = CvSplit(3)
 
 m_CodeVer = m_Version & SEP & m_Major & SEP & m_Minor & SEP & MinusPatch
 
 Application.EnableEvents = False
 MobjUserForm.txt_VersionControlString = m_CodeVer
 Application.EnableEvents = True
 
 End Function
 Public Function MinusVersion(Version As Long) As String
 MsCodeVer = "3.0.4.1"
 Dim CvSplit As Variant
 
 CvSplit = Split(MobjUserForm.txt_VersionControlString.Value, ".")
 
 MinusVersion = Format(CLng(CvSplit(0)) - Version, "0")
 
 ' MinusVersion = Format(CLng(MobjUserForm.Version.Caption) - Version, "0")
 
 If MinusVersion < 0 Then MinusVersion = "0"
 
 If MobjUserForm.chk_UpdateVersion.Value = True Then
 Call AddCodeVerVersionConst(MobjUserForm.cbo_Workbook.Value, MinusVersion)
 MobjUserForm.chk_UpdateVersion.Value = False
 End If
 'm_Version = CvSplit(0)
 m_Major = CvSplit(1)
 m_Minor = CvSplit(2)
 m_Patch = CvSplit(3)
 
 m_CodeVer = MinusVersion & SEP & m_Major & SEP & m_Minor & SEP & m_Patch
 
 Application.EnableEvents = False
 MobjUserForm.txt_VersionControlString = m_CodeVer
 Application.EnableEvents = True
 
 End Function
 Public Function ReadCodeVer(ByVal Workbook As String, ByVal Module As String, ByVal Procedure As String) As String
 MsCodeVer = "3.0.4.1"
 Dim CodeMod As VBIDE.CodeModule
 Dim StartLine As Long
 Dim EndLine As Long
 Dim CountOfLine As Long
 Dim TrimLines As Variant
 Dim CvSplit As String
 
 Set CodeMod = Workbooks(Workbook).VBProject.VBComponents(Module).CodeModule
 
 With CodeMod
 StartLine = GetProcInfo(Workbook, Module, Procedure, "StartLine")
 EndLine = GetProcInfo(Workbook, Module, Procedure, "EndLine")
 For CountOfLine = StartLine + 1 To EndLine - 1
 TrimLines = Trim(.Lines(CountOfLine, 1))
 If TrimLines Like "MsCodeVer = *" Then
 CvSplit = Split(Trim(.Lines(CountOfLine, 1)), "MsCodeVer = ")(1)
 ReadCodeVer = Mid(CvSplit, 2, Len(CvSplit) - 2)
 Exit Function
 End If
 Next CountOfLine
 ReadCodeVer = SNOVC
 End With
 End Function
 Public Sub ReadModuleCodeVer(ByVal Workbook As String, ByVal Module As String, Optional RemoveCodeVerMod As Boolean = False)
 MsCodeVer = "3.0.4.1"
 Dim Counter As Long
 Dim CodeMod As CodeModule
 Dim TrimLines As String
 Dim CodeVerMod As String
 Dim CodeVer As CCodeVer
 Dim CvSplit As Variant
 Dim OptionExplicit As Long
 
 If Workbook = vbNullString Then Exit Sub
 If Module = vbNullString Then Exit Sub
 
 Set CodeMod = Workbooks(Workbook).VBProject.VBComponents(Module).CodeModule
 Set CodeVer = New CCodeVer
 
 'search first for const string, if found read codever
 With CodeMod
 CvSplit = Split(MobjUserForm.txt_VersionControlString.Value, ".")
 If .CountOfDeclarationLines = 0 Then
 .InsertLines 1, "Option Explicit"
 .InsertLines 2, "Private Const MSCODEVERMOD As String = " & Chr(34) & CvSplit(0) & SEP & CvSplit(1) & SEP & CvSplit(2) & Chr(34)
 Exit Sub
 ElseIf .CountOfDeclarationLines = 1 Then 'do i need to check for Option Explicit, possibly
 .InsertLines 2, "Private Const MSCODEVERMOD As String = " & Chr(34) & CvSplit(0) & SEP & CvSplit(1) & SEP & CvSplit(2) & Chr(34)
 Exit Sub
 End If
 For Counter = 1 To .CountOfDeclarationLines
 TrimLines = Trim(.Lines(Counter, 1))
 If TrimLines = "Option Explicit" Then OptionExplicit = Counter + 1
 If TrimLines Like "Private Const MSCODEVERMOD As String*" Then
 CodeVerMod = CvSplit(0) & SEP & CvSplit(1) & SEP & CvSplit(2)
 If RemoveCodeVerMod = True Then
 .DeleteLines Counter, 1
 Else
 .ReplaceLine Counter, "Private Const MSCODEVERMOD As String = " & Chr(34) & CvSplit(0) & SEP & CvSplit(1) & SEP & CvSplit(2)
 End If
 Exit Sub
 End If
 Next Counter
 Call .InsertLines(OptionExplicit, "Private Const MSCODEVERMOD As String = " & Chr(34) & CvSplit(0) & SEP & CvSplit(1) & SEP & CvSplit(2) & Chr(34))
 End With
 
 End Sub
 Public Sub RemoveCodeVer(ByVal Workbook As String, ByVal Module As String, ByVal Procedure As String)
 MsCodeVer = "3.0.4.1"
 Dim CodeMod As VBIDE.CodeModule
 Dim StartLine As Long
 Dim EndLine As Long
 Dim CounterOfLine As Long
 Dim TrimLines As String
 
 Set CodeMod = Workbooks(Workbook).VBProject.VBComponents(Module).CodeModule
 
 With CodeMod
 StartLine = FindLastParenthesis(Workbook, Module, Procedure)
 EndLine = GetProcInfo(Workbook, Module, Procedure, "EndLine")
 For CounterOfLine = EndLine - 1 To StartLine + 1 Step -1
 TrimLines = Trim(.Lines(CounterOfLine, 1))
 If TrimLines Like "*MsCodeVer = *" Then
 If .Lines(CounterOfLine + 1, 1) = vbNullString Then .DeleteLines CounterOfLine + 1, 1
 .DeleteLines CounterOfLine, 1
 Exit For
 End If
 Next CounterOfLine
 End With
 End Sub
 Sub SearchModule(Workbook As String, Module As String, Procedure As String, ByVal CodeVerString As String, ByRef CodeMod As CodeModule, ByVal StartLine As Long, ByVal EndLine As Long)
 Dim CountOfLine As Long
 With CodeMod
 For CountOfLine = StartLine + 1 To EndLine - 1
 If Trim(.Lines(CountOfLine, 1)) Like "MsCodeVer = *" Then
 .ReplaceLine CountOfLine, " MsCodeVer = " & Chr(34) & CodeVerString & Chr(34)
 Exit Sub
 End If
 Next CountOfLine
 CountOfLine = StartLine + 1
 If Not Trim(.Lines(CountOfLine, 1)) = vbNullString Then .InsertLines CountOfLine, ""
 .InsertLines CountOfLine + 1, " MsCodeVer = " & Chr(34) & CodeVerString & Chr(34)
 If Not Trim(.Lines(CountOfLine + 2, 1)) = vbNullString Then .InsertLines CountOfLine + 2, ""
 End With
 
 End Sub

tried to post the entire userform but it bailed on me. so here is a few subprocs from the userform

 With CodeVer
 Call .AddCodeVer(objWb.Name, VbComp.Name, sProcName, MobjUserForm.txt_VersionControlString.Value)
 Call .ReadModuleCodeVer(objWb.Name, VbComp.Name)
 If Me.chk_UpdateVersion.Value = True Then
 Call .AddCodeVerVersionConst(Me.cbo_Workbook.Value, Left(.CodeVerS, 1))
 Me.chk_UpdateVersion.Value = False
 End If
 End With
 Private Sub AddMajor_Click()
 MsCodeVer = "3.0.4.1"
 Dim CodeVer As CCodeVer
 Set CodeVer = New CCodeVer
 
 With CodeVer
 If Me.chk_ShowLeadingZeros.Value = True Then
 .CodeVerS = CStr(Format(.AddMajor(1), "0000"))
 Else
 .CodeVerS = CStr(Format(.AddMajor(1), "0"))
 End If
 End With
 End Sub

and here is the code to launch my userform in the VBE

 Public Sub A0Show_Dim()
 MsCodeVer = "3.0.4.1"
 'this binds the userform to the VBE, and since it is modeless, you can edit the userform
 'code as needed
 On Error GoTo errHandler
 
 Dim MobjUserform As UDim
 Dim lAppHwnd As Long
 Dim lMeHwnd As Long
 Dim lRes As Long
 Dim objVbp As VBProject
 
 Const SUFCLASS As String = "ThunderDFrame"
 Set objVbp = Application.VBE.ActiveVBProject
 Set MobjUserform = New UDim
 Load MobjUserform
 
 lAppHwnd = Application.VBE.MainWindow.hwnd
 If lAppHwnd > 0 Then
 lMeHwnd = FindWindow(SUFCLASS, MobjUserform.Caption)
 lRes = SetParent(lMeHwnd, lAppHwnd)
 If lRes = 0 Then
 MsgBox "The call to Set Parent failed."
 End If
 Else
 MsgBox "Unable to get the window handle of the Excel Application."
 End If
 
 With MobjUserform
 .cbo_SelectWorkbook.BackColor = MCOMBOBOXBACKCOLOR
 .cbo_ContainerName.BackColor = MCOMBOBOXBACKCOLOR
 .cbo_ProcedureName.BackColor = MCOMBOBOXBACKCOLOR
 Set .Vbp = objVbp
 .Show vbModeless
 End With
 
 Exit Sub
 
 errHandler:
 
 Debug.Print Err.Number & " " & Err.Description
 Stop
 Resume
 
 End Sub

working on posting the whole workbook.

Mast
13.8k12 gold badges56 silver badges127 bronze badges
asked Oct 24, 2022 at 19:29
\$\endgroup\$
17
  • 2
    \$\begingroup\$ Can you give an overall description of what this class should do in relation to your other objects, code, workbooks, and VBA modules (since it looks like it operates on VBA code itself)? \$\endgroup\$ Commented Oct 24, 2022 at 19:57
  • 1
    \$\begingroup\$ Why are you hardcoding MsCodeVer = "3.0.4.1" in multiple places? \$\endgroup\$ Commented Oct 24, 2022 at 19:59
  • 4
    \$\begingroup\$ I can't help thinking semantic version numbers have nothing - and I mean nothing whatsoever - nothing to do in source code, even less at such a granular level. A version number for a variable? For a constant? Something is off. Change logs belong in source control, and version numbers belong in git tags/releases, not in source code... I see you're using Rubberduck - have you tried synchronizing the project with a folder, and adding that folder to source control, like a git repository? It's pretty much the industry standard solution for the kind of tracking you're looking for! \$\endgroup\$ Commented Oct 24, 2022 at 23:54
  • 1
    \$\begingroup\$ Greedo, thanks for the input. will post the Userform code where all the action happens. I can either use dropbox or onedrive for the link, but i agree with you that links die. let me update the original post with updated vba code. \$\endgroup\$ Commented Oct 25, 2022 at 17:44
  • 1
    \$\begingroup\$ @Greedo, here is the link : dropbox.com/s/e08gxifshthda51/CodeVerClass.xlam?dl=0 \$\endgroup\$ Commented Oct 25, 2022 at 19:33

1 Answer 1

1
\$\begingroup\$

One of the first observations is that the CCodeVer internally calls out to external code modules (MobjUserForm and at least one other StandardModule). ClassModules ('Classes' going forward) should be completely 'self-contained' - meaning once created and initialized, all dependencies are satisfied internally. And, any additional run-time dependencies are provided as arguments of its Public functions.

Software is a typically architected as a set of layers (e.g., UI, Domain, Data). And, typically, the implementation strives to keep Domain layer objects like CCodeVer completely unaware and independent of UI modules. The current implementation of CCodeVer both knows about MobjUserForm and assumes that it can always call back to MobjUserForm's controls properties.

So, the CCodeVer class depends on the co-existence of the external objects in order to fulfill its responsibilities. Take, for instance all the references to MobjUserForm control values. What if you would want to write an automated test for some of the functions exposed by CCodeVer? Your test setup would need a MobjUserForm instance - otherwise CCodeVer will not compile.

Code content:

From the book "Clean Code" (Robert C. Martin)

The first rule of functions is that they should be small. The second rule of functions is that they should be smaller than that.

That's nice, but the question asked is about using ClassModules in VBA - not functions. In the same book, there is, of course, a chapter about classes. The chapter on classes contains the following:

The first rule of classes is that they should be small. The second rule of classes is that they should be smaller than that.

So yeah, keeping everything small is stressed as a really good idea. Small functions are evaluated simply in terms of lines of code. Small classes are evaluated in terms of Public subroutines and functions - which in combination, describe the responsibilities of a class.

A Few Principles:

Achieving the above goals for both functions and classes depend primarily on two principles. The first is the "Don't Repeat Yourself" (DRY) principle and the second is the Single Responsibility Principle (SRP). There are certainly other useful principles in software design. But, with regard to making code elements smaller, DRY and SRP probably represent the 20 part of the 80/20 rule (the Pareto Principle... this is the last principle mentioned in this answer, I promise). That is, of all code design principles (IMO), applying DRY and SRP, lead to 80% of function and class size reductions.

Function AddCodeVer is around 172 lines long. By any standard, that is a lot of code for one function. However, it can be made smaller by applying the DRY principle. DRY would have you remove the following repeated block of code:

Set VbProj = Wb.VBProject
For Each VbComp In VbProj.VBComponents
 Module = VbComp.Name
 Set CodeMod = VbComp.CodeModule
 With CodeMod
 LineNum = .CountOfDeclarationLines + 1
 Do Until LineNum >= .CountOfLines
 Procedure = .ProcOfLine(LineNum, ProcKind)
 Select Case ProcKind
 Case vbext_pk_Get
 Procedure = Procedure & " (Get)"
 Case vbext_pk_Let
 Procedure = Procedure & " (Let)"
 Case vbext_pk_Set
 Procedure = Procedure & " (Set)"
 End Select
 If ProcKind = vbext_pk_Proc Then
 StartLine = .ProcBodyLine(Procedure, vbext_pk_Proc)
 EndLine = StartLine - 2 + .ProcCountLines(Procedure, vbext_pk_Proc)
 Call SearchModule(Workbook, Module, Procedure, CodeVerString, CodeMod, StartLine, EndLine)
 End If
 LineNum = .ProcStartLine(Split(Procedure, " (")(0), ProcKind) + _
 .ProcCountLines(Split(Procedure, " (")(0), ProcKind) + 1
 Loop
 End With
Next VbComp

The above codeblock is 27 lines that are repeated verbatim 3 times in AddCodeVer. Moving these lines into a dedicated function results in 27 x 3 = 81 lines removed from AddCodeVer. That's 54 net fewer lines to maintain and there are other similar opportunities.

With regard to classes, the CCodeVer class exposes 24 Public methods and properties. Do the 24 Public methods represent a single responsibility? CCodeVer appears to have at least 2 high-level responsibilities:

  1. Add version content to modules
  2. Support increments to the version.

One possible simplification is to have CCodeVer contain a new class CodeVersion (change the name to fit your needs). CodeVersion handles responsibility #2 above (the code below is only a partial implementation):

'Class CodeVersion
Option Explicit
Private m_Fields() As String
Private Sub Class_Initialize()
 ReDim mFields(4)
 mFields(0) = "3" 'Version
 mFields(1) = "0" 'Major
 mFields(2) = "4" 'Minor
 mFields(3) = "1" 'Patch
 
End Sub
Public Sub SetCodeVersion(ByVal cVersion As String)
 mFields = Split(cVersion, ".")
End Sub
Public Function AsString() As String
 AsString = Join(mFields, ".")
End Function
Public Function AddMajor(ByVal Major As Long, ByVal showLeadingZeroes As Boolean) As String
 
 AddMajor = SetValue(mFields(1), Major, showLeadingZeroes)
 
 If AddMajor > 9999 Then
 AddMajor = "0"
 mFields(1) = "0"
 mFields(0) = CStr(CLng(mFields(0) + 1))
 End If
 If CLng(mFields(0)) >= 999999 Then
 MsgBox ("Resetting to base string")
 mFields(0) = "0"
 mFields(1) = "0"
 mFields(2) = "0"
 mFields(3) = "0"
 End If
 
 AddMajor = Me.AsString()
 
End Function
Public Function AddMinor(ByVal Minor As Long, ByVal showLeadingZeroes As Boolean) As String
 AddMinor = SetValue(mFields(2), Minor, showLeadingZeroes)
 
 If AddMinor > 9999 Then
 AddMinor = "0"
 mFields(2) = "0"
 mFields(1) = CStr(CLng(mFields(1) + 1))
 End If
 If CLng(mFields(1)) > 9999 Then
 mFields(1) = "0"
 mFields(0) = CStr(CLng(mFields(0) + 1))
 End If
 If CLng(mFields(0)) >= 999999 Then
 mFields(0) = "0"
 If mFields(1) = "9999" Then mFields(1) = "0"
 If mFields(2) = "9999" Then mFields(2) = "0"
 If mFields(3) = "9999" Then mFields(3) = "0"
 End If
 
 AddMinor = Me.AsString()
 
End Function
Private Function SetValue(ByRef inputVal As String, ByVal elementIncrement As Long, ByVal showLeadingZeros As Boolean) As String
 If showLeadingZeros = True Then
 SetValue = Format(CLng(inputVal) + elementIncrement, "0000")
 Else
 SetValue = Format(CLng(inputVal) + elementIncrement, "0")
 End If
End Function

This would result in CCodeVer looking something like:

Option Explicit
'{...... code ...........}
Public Function AddMajor(Major As Long) As String
 
 Dim cVersion As CodeVersion
 Set cVersion = New CodeVersion
 cVersion.SetCodeVersion MobjUserForm.txt_VersionControlString.Value
 
 m_CodeVer = cVersion.AddMajor(Major, MobjUserForm.chk_ShowLeadingZeros.Value)
 MobjUserForm.txt_VersionControlString = m_CodeVer
 
 ResetFlags
 
 AddMajor = m_CodeVer
End Function
Public Function AddMinor(Minor As Long) As String
 Dim cVersion As CodeVersion
 Set cVersion = New CodeVersion
 cVersion.SetCodeVersion MobjUserForm.txt_VersionControlString.Value
 m_CodeVer = cVersion.AddMinor(Minor, MobjUserForm.chk_ShowLeadingZeros.Value)
 
 MobjUserForm.txt_VersionControlString = m_CodeVer
 
 ResetFlags
 
 AddMinor = mCodeVer
 
End Function
Private Sub ResetFlags()
 Application.EnableEvents = False
 Application.EnableEvents = True
End Sub
'{...... code ...........}

The primary improvement is that CodeVersion has zero dependencies on any global variables or the UserForm. It is now possible to write test code that exercises code like CodeVersion.AddMinor with various inputs. No other modules are required for CodeVersion to fulfill its responsibilities.

Further, CCodeVer no longer contains the code responsible for incrementing version strings. It is now smaller because it has delegated that work to a more specialized object. CCodeVer's Public interface now has the option to expose a single Get property for a CodeVersion object and remove all the Let/Get properties (depending on how these properties are actually used).

CCodeVer retains the responsibility of writing version strings to the various workbooks. But, even that responsibility can be, and perhaps should be, implemented by yet another class. Doing so would result in CCodeVer having the single responsibility of a coordinating interactions between the UI layer and the appropriate Domain layer objects.

One way in that ClassModule programing differs from StandardModule programming is that classes can be built-up using other classes. Classes can contain classes...whereas StandardModules cannot contain other StandardModules but rather have to interact through globally available functions and variables. Additionally, StandardModules cannot be passed into functions as arguments or exposed as a function return value...but classes can.

It's great that you are adding ClassModules to your set of VBA tools. By adding classes to your VBA code, you are embarking on a path towards Object Oriented Programming (OOP). To move you along the OOP learning curve more quickly, you will benefit from studying the references mentioned above as well as content available here.

answered Oct 28, 2022 at 17:18
\$\endgroup\$
8
  • \$\begingroup\$ that is exactly the code review that i was looking for. did i get my Class right (I didn't). will have to reread and unpack what you have said but this is what I was looking for. thanks for the lengthy reply. will do as you have said, will come back here if I run into any problems. \$\endgroup\$ Commented Nov 3, 2022 at 19:02
  • \$\begingroup\$ My first question is should i move the ShowUCodeVer code to the class then? that way the code is all in the class. did I understand this correctly? (don't think so as I am running into compile issues) \$\endgroup\$ Commented Nov 3, 2022 at 21:27
  • \$\begingroup\$ But now the issues are gone, and it loads up. need further testing but I would like to post my new GET/SET property for your review. seems like I might have it. still rereading your post to get further understanding \$\endgroup\$ Commented Nov 3, 2022 at 22:26
  • \$\begingroup\$ So something is wrong with my GET. see the following two statements, what did i do wrong? Public Property Get MUserform() As UCodeVerClass: Set MUserform = m_Userform: End Property Public Property Set MUserform(ByRef UF As UCodeVerClass): Set m_Userform = UF: End Property \$\endgroup\$ Commented Nov 4, 2022 at 15:56
  • \$\begingroup\$ it fails on the Get \$\endgroup\$ Commented Nov 4, 2022 at 15:56

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.