How can I automatically populate the VBA Editor with line numbers?

Question

I want to have line numbers in my VBA code for debugging reasons. That will allow me to know where a particular error occurred.

Is there an automatic feature for thi

Answer 1

This Works for me...Add this to its own module. Calling the code will toggle line numbers on or off. Adding Module titles and/or procedure titles in quotes will update only the module or procedure named.

    Option Compare Database
    Option Explicit

    Sub AddLineNumbers(Optional vbCompName As String, Optional vbCompSubName As String)
    On Error Resume Next

        DoCmd.Hourglass True
        Application.VBE.ActiveVBProject.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 5, 0
        Call ExecuteAddLineNumbers(vbCompName, vbCompSubName)
        DoCmd.Hourglass False

    End Sub

    Sub ExecuteAddLineNumbers(Optional vbCompName As String, Optional vbCompSubName As String)
    On Error GoTo Err_Handler

        'create a reference to the Microsoft Visual Basic for Applications Extensibility library
        Dim i As Long, j As Long, lineN As Long
        Dim procName As String
        Dim startOfProceedure As Long
        Dim lengthOfProceedure As Long
        Dim newLine As String
        Dim objComponent As Object
        Dim lineNumber As Long
        Dim HasLineNumbers As Boolean

        For Each objComponent In Application.VBE.ActiveVBProject.VBComponents
            If (vbCompName = vbNullString Or objComponent.Name = vbCompName) And objComponent.Name <> _
            Application.VBE.ActiveCodePane.CodeModule.Name) Then
                Debug.Print objComponent.Name
                With objComponent.CodeModule
                    .CodePane.Window.Visible = False
                    For i = 1 To .CountOfLines
                        'Debug.Print .ProcOfLine(i, vbext_pk_Proc)
                        If procName = "" And .ProcOfLine(i, vbext_pk_Proc) <> "" Then
                            procName = .ProcOfLine(i, vbext_pk_Proc)
                            'vbext_pk_Get    Specifies a procedure that returns the value of a property.
                            'vbext_pk_Let    Specifies a procedure that assigns a value to a property.
                            'vbext_pk_Set    Specifies a procedure that sets a reference to an object.
                            'vbext_pk_Proc   Specifies all procedures other than property procedures.
                            'type=vbext_ct_ClassModule
                            'type=vbext_ct_StdModule
                            'type=vbext_ct_Document
                            If objComponent.Type = vbext_ct_ClassModule Then
                                If InStr(.Lines(i + 1, 1), " Let ") > 0 Then
                                    startOfProceedure = .ProcStartLine(procName, vbext_pk_Let)
                                    lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Let)
                                ElseIf InStr(.Lines(i + 1, 1), " Get ") > 0 Then
                                    startOfProceedure = .ProcStartLine(procName, vbext_pk_Get)
                                    lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Get)
                                ElseIf InStr(.Lines(i + 1, 1), " Set ") > 0 Then
                                    startOfProceedure = .ProcStartLine(procName, vbext_pk_Set)
                                    lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Set)
                                Else
                                    startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc)
                                    lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Proc)
                                End If
                            Else
                                startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc)
                                lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Proc)
                            End If
                            lineNumber = 10
                            HasLineNumbers = .Find("##  ", startOfProceedure + 1, 1, startOfProceedure + lengthOfProceedure - 1, 1, _
                            False, False, True)
                        End If

                        If (vbCompSubName = vbNullString And procName <> vbNullString) Or _
                           (vbCompSubName <> vbNullString And procName = vbCompSubName) Then

                            If startOfProceedure + 1 < i And i < startOfProceedure + lengthOfProceedure - 1 Then
                                newLine = RemoveOneLineNumber(.Lines(i, 1), HasLineNumbers)
                                If Trim(newLine) <> vbNullString Then
                                    If Not HasLabel(newLine) And Not (.Lines(i - 1, 1) Like "* _") Then
                                        If HasLineNumbers = False Then newLine = CStr(lineNumber) & vbTab & newLine
                                        .ReplaceLine i, newLine
                                        lineNumber = lineNumber + 10
                                    ElseIf Not HasLineNumbers Then
                                        .ReplaceLine i, vbTab & newLine
                                    Else
                                        .ReplaceLine i, newLine
                                    End If
                                End If
                            ElseIf i = startOfProceedure + lengthOfProceedure - 1 Then
                                procName = ""
                            End If
                        Else
                            procName = ""
                        End If

                    Next i
                    .CodePane.Window.Visible = True
                End With
            End If
        Next objComponent

    Exit Sub

    Err_Handler:
        MsgBox (Err.Number & ": " & Err.Description)

    End Sub

    Function RemoveOneLineNumber(aString As String, HasLineNumbers As Boolean)
        Dim i As Double
        RemoveOneLineNumber = aString
        i = ((Len(Trim(Str(Val(aString)))) / 4) - Int(Len(Trim(Str(Val(aString)))) / 4)) * 4
        If aString Like "#*" Then
            RemoveOneLineNumber = Space(i) & Mid(aString, InStr(1, aString, " ", vbTextCompare))
            RemoveOneLineNumber = Right(aString, Len(aString) - 4)
        ElseIf HasLineNumbers And aString Like "    *" Then
            RemoveOneLineNumber = Right(aString, Len(aString) - 4)
        End If
    End Function

    Function HasLabel(ByVal aString As String) As Boolean
        HasLabel = False
        If Right(Trim(aString), 1) = ":" Or _
            Left(Trim(aString), 3) = "Dim" Or _
            Left(Trim(aString), 3) = "ReDim" Or _
            Left(Trim(aString), 1) = "'" Or _
            Left(Trim(aString), 6) = "Option" Or _
            Left(Trim(aString), 5) = "Debug" Or _
            Left(Trim(aString), 3) = "Sub" Or _
            Left(Trim(aString), 11) = "Private Sub" Or _
            Left(Trim(aString), 10) = "Public Sub" Or _
            Left(Trim(aString), 8) = "Function" Or _
            Left(Trim(aString), 12) = "End Function" Or _
            Left(Trim(aString), 8) = "Property" Or _
            Left(Trim(aString), 12) = "End Property" Or _
            Left(Trim(aString), 7) = "End Sub" Then HasLabel = True

    End Function