Consulting

Results 1 to 1 of 1

Thread: Line Numbering in Subroutine

  1. #1

    Line Numbering in Subroutine

    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-...mbers-vba.html
    ' https://windowssecrets.com/forums/sh...rs-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-...mbers-vba.html
    ' https://windowssecrets.com/forums/sh...rs-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
    Last edited by Paul_Hossler; 05-17-2020 at 08:10 PM. Reason: Added CODE tags

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •