Modify project modules

amarokWPcom

New Member
Joined
May 30, 2019
Messages
25
Good morning,

to add or remove line numbers in my subroutines 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.

Original Code to Add Line Numbers I found online:

VBA Code:
' 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
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Forum statistics

Threads
1,215,054
Messages
6,122,893
Members
449,097
Latest member
dbomb1414

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top