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.
1 Answer 1
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:
- Add version content to modules
- 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.
-
\$\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\$DanM– DanM2022年11月03日 19:02:44 +00:00Commented 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\$DanM– DanM2022年11月03日 21:27:53 +00:00Commented 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\$DanM– DanM2022年11月03日 22:26:25 +00:00Commented 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\$DanM– DanM2022年11月04日 15:56:04 +00:00Commented Nov 4, 2022 at 15:56
-
\$\begingroup\$ it fails on the Get \$\endgroup\$DanM– DanM2022年11月04日 15:56:24 +00:00Commented Nov 4, 2022 at 15:56
MsCodeVer = "3.0.4.1"
in multiple places? \$\endgroup\$