amarokWPcom
05-13-2020, 01:36 AM
Good morning,
to add or remove line numbers in my subroutines in EXCEL I found and use a good working subroutine (Code at the end of this thread).
Now I want to add/remove line numbers also in my OUTLOOK VBA projects.
But I don't get the correct setting of one column of the code which is this:
...
With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
...
This line declares/sets my project in EXCEL to add/remove line numbers, but I have no clue how to change the beginning for OUTLOOK VB.
If you have another working solution how to add/remove line numbers to your subroutines in OUTLOOK many thanks for your answer ;)
Original Code to Add Line Numbers I found online:
' Attention!!!! Following reference has to be addded to project
' Microsoft Visual Basic for Applications Extensibility 5.3.
' Source:
' https://www.mrexcel.com/forum/excel-questions/576449-code-line-numbers-vba.html
' https://windowssecrets.com/forums/showthread.php/172507-line-numbers-in-VBA-code
Sub AddLineNumbers()
Dim i As Long, j As Long, lineN As Long
Dim procName As String
Dim startOfProceedure As Long
Dim lengthOfProceedure As Long
Dim ModuleName As String
Dim ReplaceJump, LineValue, PrevLineValue, LenLine, YesNo
ModuleName = InputBox("Please write Modul name to add line numbers")
'ModuleName = "YourModuleName" 'Paste module name where lines' numbers should be added
YesNo = MsgBox("Would you like to add code lines to module: '" & ModuleName & "'?", vbQuestion + vbYesNo, "QUESTION...")
If YesNo = 6 Then
With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
For i = 1 To .CountOfLines
procName = .ProcOfLine(i, vbext_pk_Proc)
If procName <> vbNullString Then
startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc)
If i = startOfProceedure Then
lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Proc)
For j = 2 To lengthOfProceedure - 2
lineN = startOfProceedure + j
' ----------------------------
' EXCLUSION
LineValue = .lines(lineN, 1)
PrevLineValue = .lines(lineN - 1, 1)
If Len(Trim(.lines(lineN, 1))) = 0 Then
GoTo ReplaceJump
End If
If Right(PrevLineValue, 1) = "_" Then
.ReplaceLine lineN, " " & vbTab & vbTab & .lines(lineN, 1) 'ori
GoTo ReplaceJump
End If
If Right(LineValue, 1) = ":" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 4) = "Case" Then
.ReplaceLine lineN, " " & vbTab & vbTab & .lines(lineN, 1) 'ori
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 6) = "Public" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 7) = "Private" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 3) = "Sub" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 8) = "Function" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 12) = "End Function" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 3) = "Debug" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 7) = "End Sub" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 1) = "'" Then
.ReplaceLine lineN, vbTab & vbTab & .lines(lineN, 1) 'ori
GoTo ReplaceJump
End If
' ----------------------------
' ADDING LINE CODE
If lineN < 100 Then
.ReplaceLine lineN, CStr(lineN) & ":" & vbTab & vbTab & .lines(lineN, 1)
Else
.ReplaceLine lineN, CStr(lineN) & ":" & vbTab & .lines(lineN, 1)
End If
ReplaceJump:
Next j
End If
End If
Next i
End With
MsgBox "Code lines has been added.", vbInformation, "CONFIRMATION..."
Else
MsgBox "Canceled."
End If
End Sub
' Attention!!! Following reference has to be added:
' Microsoft Visual Basic for Applications Extensibility 5.3.
' Source:
' https://www.mrexcel.com/forum/excel-questions/576449-code-line-numbers-vba.html
' https://windowssecrets.com/forums/showthread.php/172507-line-numbers-in-VBA-code
Sub RemoveLineNumber()
' REMOVING CODE LINES
Dim i As Long, j As Long, lineN As Long
Dim procName As String
Dim startOfProceedure As Long
Dim lengthOfProceedure As Long
Dim ModuleName As String
Dim ReplaceJump, LineValue, PrevLineValue, LenLine, YesNo
ModuleName = InputBox("Please write Modul name to remove line numbers")
'ModuleName = "YourModuleName" 'Paste module name where code lines has to be removed
YesNo = MsgBox("Would you like to remove lines numbers from: '" & ModuleName & "'?", vbQuestion + vbYesNo, "QUESTION...")
If YesNo = 6 Then
With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
For i = 1 To .CountOfLines
procName = .ProcOfLine(i, vbext_pk_Proc)
If procName <> vbNullString Then
startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc)
If i = startOfProceedure Then
lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Proc)
For j = 2 To lengthOfProceedure - 2
lineN = startOfProceedure + j
' ----------------------------
' EXCLUSION
LineValue = .lines(lineN, 1)
PrevLineValue = .lines(lineN - 1, 1)
If Len(.lines(lineN, 1)) = 0 Then
.ReplaceLine lineN, .lines(lineN, 1)
GoTo ReplaceJump
End If
If Right(PrevLineValue, 1) = "_" Then
.ReplaceLine lineN, Right(.lines(lineN, 1), Len(.lines(lineN, 1)) - 8)
GoTo ReplaceJump
End If
If Right(LineValue, 1) = ":" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 4) = "Case" Then
.ReplaceLine lineN, Right(.lines(lineN, 1), Len(.lines(lineN, 1)) - 8)
End If
If Left(Trim(LineValue), 6) = "Public" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 7) = "Private" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 3) = "Sub" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 3) = "Debug" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 8) = "Function" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 12) = "End Function" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 7) = "End Sub" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 7) = "" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 1) = "'" Then
.ReplaceLine lineN, Right(.lines(lineN, 1), Len(.lines(lineN, 1)) - 8)
GoTo ReplaceJump
End If
' ----------------------------
' REMOVING LINE'S NUMBER
.ReplaceLine lineN, Right(.lines(lineN, 1), Len(.lines(lineN, 1)) - 8)
ReplaceJump:
Next j
End If
End If
Next i
End With
MsgBox "Line number has been removed.", vbInformation, "CONFIRMATION..."
Else
MsgBox "Canceled."
End If
End Sub
to add or remove line numbers in my subroutines in EXCEL I found and use a good working subroutine (Code at the end of this thread).
Now I want to add/remove line numbers also in my OUTLOOK VBA projects.
But I don't get the correct setting of one column of the code which is this:
...
With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
...
This line declares/sets my project in EXCEL to add/remove line numbers, but I have no clue how to change the beginning for OUTLOOK VB.
If you have another working solution how to add/remove line numbers to your subroutines in OUTLOOK many thanks for your answer ;)
Original Code to Add Line Numbers I found online:
' Attention!!!! Following reference has to be addded to project
' Microsoft Visual Basic for Applications Extensibility 5.3.
' Source:
' https://www.mrexcel.com/forum/excel-questions/576449-code-line-numbers-vba.html
' https://windowssecrets.com/forums/showthread.php/172507-line-numbers-in-VBA-code
Sub AddLineNumbers()
Dim i As Long, j As Long, lineN As Long
Dim procName As String
Dim startOfProceedure As Long
Dim lengthOfProceedure As Long
Dim ModuleName As String
Dim ReplaceJump, LineValue, PrevLineValue, LenLine, YesNo
ModuleName = InputBox("Please write Modul name to add line numbers")
'ModuleName = "YourModuleName" 'Paste module name where lines' numbers should be added
YesNo = MsgBox("Would you like to add code lines to module: '" & ModuleName & "'?", vbQuestion + vbYesNo, "QUESTION...")
If YesNo = 6 Then
With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
For i = 1 To .CountOfLines
procName = .ProcOfLine(i, vbext_pk_Proc)
If procName <> vbNullString Then
startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc)
If i = startOfProceedure Then
lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Proc)
For j = 2 To lengthOfProceedure - 2
lineN = startOfProceedure + j
' ----------------------------
' EXCLUSION
LineValue = .lines(lineN, 1)
PrevLineValue = .lines(lineN - 1, 1)
If Len(Trim(.lines(lineN, 1))) = 0 Then
GoTo ReplaceJump
End If
If Right(PrevLineValue, 1) = "_" Then
.ReplaceLine lineN, " " & vbTab & vbTab & .lines(lineN, 1) 'ori
GoTo ReplaceJump
End If
If Right(LineValue, 1) = ":" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 4) = "Case" Then
.ReplaceLine lineN, " " & vbTab & vbTab & .lines(lineN, 1) 'ori
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 6) = "Public" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 7) = "Private" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 3) = "Sub" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 8) = "Function" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 12) = "End Function" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 3) = "Debug" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 7) = "End Sub" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 1) = "'" Then
.ReplaceLine lineN, vbTab & vbTab & .lines(lineN, 1) 'ori
GoTo ReplaceJump
End If
' ----------------------------
' ADDING LINE CODE
If lineN < 100 Then
.ReplaceLine lineN, CStr(lineN) & ":" & vbTab & vbTab & .lines(lineN, 1)
Else
.ReplaceLine lineN, CStr(lineN) & ":" & vbTab & .lines(lineN, 1)
End If
ReplaceJump:
Next j
End If
End If
Next i
End With
MsgBox "Code lines has been added.", vbInformation, "CONFIRMATION..."
Else
MsgBox "Canceled."
End If
End Sub
' Attention!!! Following reference has to be added:
' Microsoft Visual Basic for Applications Extensibility 5.3.
' Source:
' https://www.mrexcel.com/forum/excel-questions/576449-code-line-numbers-vba.html
' https://windowssecrets.com/forums/showthread.php/172507-line-numbers-in-VBA-code
Sub RemoveLineNumber()
' REMOVING CODE LINES
Dim i As Long, j As Long, lineN As Long
Dim procName As String
Dim startOfProceedure As Long
Dim lengthOfProceedure As Long
Dim ModuleName As String
Dim ReplaceJump, LineValue, PrevLineValue, LenLine, YesNo
ModuleName = InputBox("Please write Modul name to remove line numbers")
'ModuleName = "YourModuleName" 'Paste module name where code lines has to be removed
YesNo = MsgBox("Would you like to remove lines numbers from: '" & ModuleName & "'?", vbQuestion + vbYesNo, "QUESTION...")
If YesNo = 6 Then
With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
For i = 1 To .CountOfLines
procName = .ProcOfLine(i, vbext_pk_Proc)
If procName <> vbNullString Then
startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc)
If i = startOfProceedure Then
lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Proc)
For j = 2 To lengthOfProceedure - 2
lineN = startOfProceedure + j
' ----------------------------
' EXCLUSION
LineValue = .lines(lineN, 1)
PrevLineValue = .lines(lineN - 1, 1)
If Len(.lines(lineN, 1)) = 0 Then
.ReplaceLine lineN, .lines(lineN, 1)
GoTo ReplaceJump
End If
If Right(PrevLineValue, 1) = "_" Then
.ReplaceLine lineN, Right(.lines(lineN, 1), Len(.lines(lineN, 1)) - 8)
GoTo ReplaceJump
End If
If Right(LineValue, 1) = ":" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 4) = "Case" Then
.ReplaceLine lineN, Right(.lines(lineN, 1), Len(.lines(lineN, 1)) - 8)
End If
If Left(Trim(LineValue), 6) = "Public" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 7) = "Private" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 3) = "Sub" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 3) = "Debug" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 8) = "Function" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 12) = "End Function" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 7) = "End Sub" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 7) = "" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 1) = "'" Then
.ReplaceLine lineN, Right(.lines(lineN, 1), Len(.lines(lineN, 1)) - 8)
GoTo ReplaceJump
End If
' ----------------------------
' REMOVING LINE'S NUMBER
.ReplaceLine lineN, Right(.lines(lineN, 1), Len(.lines(lineN, 1)) - 8)
ReplaceJump:
Next j
End If
End If
Next i
End With
MsgBox "Line number has been removed.", vbInformation, "CONFIRMATION..."
Else
MsgBox "Canceled."
End If
End Sub