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

五迷三道 提交于 2019-12-01 20:51:48

问题


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 this (such as an option in settings)? Or do I need to write my own macro?

If I need to write my own macro to accomplish this task, how would I go about doing such a thing?


回答1:


You don't want line numbers.

Not for "debugging reasons", not for anything. Line numbers are deprecated for a reason: they're a relic of an ancient time before procedures even existed, and GOTO the only way to get anywhere.

Erl only returns the last encountered line number before an error was raised. This can mean misleading error logs, if you're logging errors:

Sub DoSomething()
10 On Error GoTo 50
   Debug.Print 42 / 0
30 Exit Sub

50 Debug.Print "Error raised on line " & Erl 'returns 10
End Sub

Also, line numbers only have Integer resolution (a VBA module can have up to 65,535 lines, which is twice that resolution), and will silently fail and happily report wrong line numbers if you don't keep that in mind:

Sub DoSomething()
99997 On Error GoTo 99999
99998 Debug.Print 42 / 0
99999
      Debug.Print Erl   'Prints 34462 - and which line is that?
End Sub

Any serious VBA application will use structured error handling instead.

Write small, specialized procedures (i.e. write code that follows modern-day best practices), and the line number becomes utterly meaningless.

Line numbers are a pain in the neck to maintain; they clutter up the code and make it overall harder to read (and therefore to debug).


That said, IIRC MZ-Tools 3 had such a functionality.

Keep in mind, that BASIC looked like this when line numbers were a thing:

10 GOSUB 100
20 GOSUB 1000
99 END
100 REM CLEAR SCREEN
110 PRINT CHR$(147)
120 RETURN
200 REM MODULO
210 LET MOD% = V%-INT(V%/FB%)*FB%
220 RETURN
1000 REM INIT VARIABLES
1010 LET FIZZ$ = "FIZZ"
1011 LET BUZZ$ = "BUZZ"
1020 LET FIZZ% = 3
1021 LET BUZZ% = 5
1030 LET MIN% = 1
1031 LET MAX% = 15
1100 PRINT FIZZ$ + ":" + STR$(FIZZ%)
1101 PRINT BUZZ$ + ":" + STR(BUZZ%)
1102 PRINT FIZZ$ + BUZZ$ + ":" + STR$(FIZZ%*BUZZ%)
1105 PRINT
2000 REM ACTUAL FIZZBUZZ LOOP
2010 FOR X = MIN% TO MAX%
2015 LET RESULT$ = STR$(X)
2020 LET FB% = FIZZ%*BUZZ%
2021 LET V% = X
2024 GOSUB 200
2025 IF MOD%=0 THEN LET RESULT$=FIZZ$+BUZZ$ : GOTO 2050
2030 LET FB% = FIZZ%
2031 GOSUB 200
2035 IF MOD%=0 THEN LET RESULT$=FIZZ$ : GOTO 2050
2040 LET FB% = BUZZ%
2041 GOSUB 200
2045 IF MOD%=0 THEN LET RESULT$=BUZZ$ : GOTO 2050
2050 PRINT RESULT$
2090 NEXT X
2099 RETURN

The above is a working Commodore 64 BASIC 2.0 fizzbuzz program. VBA has fabulous backward-compatibility. With only slight modifications, it runs in VBA:

Sub Main()
10     GoSub 100
20     GoSub 1000
99     End
100     Rem CLEAR SCREEN
110     'Debug.Print Chr$(147) 'Chr$(147) was a special character on C64
120     Return
200     Rem MODULO
210     Let Modulo% = V% - Int(V% / FB%) * FB%
220     Return
1000     Rem INIT VARIABLES
1010     Let FIZZ$ = "FIZZ"
1011     Let BUZZ$ = "BUZZ"
1020     Let FZZ% = 3
1021     Let BZZ% = 5
1030     Let Min% = 1
1031     Let Max% = 15
1100     Debug.Print FIZZ$ + ":" + Str$(FZZ%)
1101     Debug.Print BUZZ$ + ":" + Str(BZZ%)
1102     Debug.Print FIZZ$ + BUZZ$ + ":" + Str$(FZZ% * BZZ%)
1105     Debug.Print
2000     Rem ACTUAL FIZZBUZZ LOOP
2010     For X = Min% To Max%
2015     Let RESULT$ = Str$(X)
2020     Let FB% = FZZ% * BZZ%
2021     Let V% = X
2024     GoSub 200
2025     If Modulo% = 0 Then Let RESULT$ = FIZZ$ + BUZZ$: GoTo 2050
2030     Let FB% = FZZ%
2031     GoSub 200
2035     If Modulo% = 0 Then Let RESULT$ = FIZZ$: GoTo 2050
2040     Let FB% = BZZ%
2041     GoSub 200
2045     If Modulo% = 0 Then Let RESULT$ = BUZZ$: GoTo 2050
2050     Debug.Print RESULT$
2090     Next X
2099     Return
End Sub

Don't write 1980's code, we're 40 years later.




回答2:


I use this code for adding line numbers to my Excel projects. I found it online a while back and I don't remember where I got it, so credit goes to whoever originally wrote this:

Sub AddLineNumbers(wbName As String, vbCompName As String)
    'See MakeUF
    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

    With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule
        .CodePane.Window.Visible = False

        For i = 1 To .CountOfLines
            procName = .ProcOfLine(i, vbext_pk_Proc)

            If procName <> vbNullString Then
                startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc)
                lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Proc)

                If startOfProceedure + 1 < i And i < startOfProceedure + lengthOfProceedure - 1 Then
                    newLine = RemoveOneLineNumber(.Lines(i, 1))
                    If Not HasLabel(newLine) And Not (.Lines(i - 1, 1) Like "* _") Then
                        .ReplaceLine i, CStr(i) & ":" & newLine
                    End If
                End If
            End If

        Next i
        .CodePane.Window.Visible = True
    End With
End Sub

Sub RemoveLineNumbers(wbName As String, vbCompName As String)
    'See MakeUF
    Dim i As Long
    With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule
        For i = 1 To .CountOfLines
            .ReplaceLine i, RemoveOneLineNumber(.Lines(i, 1))
        Next i
    End With
End Sub

Function RemoveOneLineNumber(aString)
    RemoveOneLineNumber = aString
    If aString Like "#:*" Or aString Like "##:*" Or aString Like "###:*" Then
        RemoveOneLineNumber = Mid(aString, 1 + InStr(1, aString, ":", vbTextCompare))
    End If
End Function

Function HasLabel(ByVal aString As String) As Boolean
    HasLabel = InStr(1, aString & ":", ":") < InStr(1, aString & " ", " ")
End Function

You'll have to modify it to suit your needs since you're working in Access, but I'm sure the main meat of it still applies. In Excel, there's a userform that is used to kick off the code for the module you specify, but you should be able to just pass in the module name (vbCompName) to specify the module. I'm not well-versed in Access VBA, so I'm not sure what you'd replace Workbooks(wbName) with in the code.




回答3:


The VBA editor has a built in way to see a line number, under the 'Standard' toolbar:

When you select a line of code, the line number will be represented here next to 'Ln'.




回答4:


MZ-Tools for VBA has functions to add and remove line numbers to single functions, modules, or the whole project.

See http://www.mztools.com/v8/onlinehelp/index.html?add_remove_line_numbers.htm

Note 1: I find it better to configure the line number increment to 1 instead of 10. You will never manually add line numbers inbetween - whenever you edit the code, you first remove the line numbers, then add them back when you are finished.

Note 2: Until a few years ago, there was a free version 3.0 of MZ-Tools, but it is surprisingly difficult to find a copy. But it is a good investment - there are lots of other useful features (e.g. the automatic adding of error handlers).




回答5:


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



回答6:


This is not 100% tested, but using VBA extensibility you could do the following

Sub line_number(strModuleName As String)

Dim vbProj As VBProject
Dim vbComp As VBComponent
Dim cmCode As CodeModule
Dim intLine As Integer

Set vbProj = Application.VBE.ActiveVBProject
Set vbComp = vbProj.VBComponents(strModuleName)
Set cmCode = vbComp.CodeModule

For intLine = 2 To cmCode.CountOfLines - 1
   cmCode.InsertLines intLine, intLine - 1 &  cmCode.Lines(intLine, 1)
   cmCode.DeleteLines intLine + 1, 1
Next intLine

End Sub

This gives the results before and after as below, altering in this way is not recommended though.




回答7:


The answer of Arich works like a charm on an individual module. If you want to provide your entire workbook with (updated) line numbers you apply the following steps*^:

Do Once:

  1. Paste the large code from Module2 in your workbook.
  2. Paste the code for Module3 in your workbook.
  3. Paste the code for Module4 in your workbook.
  4. Then paste the line Global allow_for_line_addition As Stringthis is just so that you can automatically add linenumbers` above/in the first line of every module.
  5. Delete all empty lines at the end of each module (so no lose enters after the last end sub,end function or End Property of a module).
  6. In the VBA editor, while not running a code, and not being in "break"-mode:click tools>references>mark: `Microsoft Visual Basic for Applications Extensibility 5.3"

Do every time you have modified your code:

  1. °Run the code for Module3 to remove line numbers to all the modules in your workbook.
  2. °Run the code for Module4 to add line numbers to all the modules in your workbook.

Module2:

    Public Enum vbLineNumbers_LabelTypes
        vbLabelColon    ' 0
        vbLabelTab      ' 1
    End Enum

    Public Enum vbLineNumbers_ScopeToAddLineNumbersTo
        vbScopeAllProc  ' 1
        vbScopeThisProc ' 2
    End Enum
              Sub AddLineNumbers(ByVal wbName As String, _
                                                          ByVal vbCompName As String, _
                                                          ByVal LabelType As vbLineNumbers_LabelTypes, _
                                                          ByVal AddLineNumbersToEmptyLines As Boolean, _
                                                          ByVal AddLineNumbersToEndOfProc As Boolean, _
                                                          ByVal Scope As vbLineNumbers_ScopeToAddLineNumbersTo, _
                                                          Optional ByVal thisProcName As String)

    ' USAGE RULES
    ' DO NOT MIX LABEL TYPES FOR LINE NUMBERS! IF ADDING LINE NUMBERS AS COLON TYPE, ANY LINE NUMBERS AS VBTAB TYPE MUST BE REMOVE BEFORE, AND RECIPROCALLY ADDING LINE NUMBERS AS VBTAB TYPE

        Dim i As Long
        Dim j As Long
        Dim procName As String
        Dim startOfProcedure As Long
        Dim lengthOfProcedure As Long
        Dim endOfProcedure As Long
        Dim strLine As String

        With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule
            .CodePane.Window.Visible = False

    If Scope = vbScopeAllProc Then

            For i = 1 To .CountOfLines - 1

                strLine = .Lines(i, 1)
                procName = .ProcOfLine(i, vbext_pk_Proc) ' Type d'argument ByRef incompatible ~~> Requires VBIDE library as a Reference for the VBA Project

                If procName <> vbNullString Then
                    startOfProcedure = .ProcStartLine(procName, vbext_pk_Proc)
                    bodyOfProcedure = .ProcBodyLine(procName, vbext_pk_Proc)
                    countOfProcedure = .ProcCountLines(procName, vbext_pk_Proc)

                    prelinesOfProcedure = bodyOfProcedure - startOfProcedure
                    'postlineOfProcedure = ??? not directly available since endOfProcedure is itself not directly available.

                    lengthOfProcedure = countOfProcedure - prelinesOfProcedure ' includes postlinesOfProcedure !
                    'endOfProcedure = ??? not directly available, each line of the proc must be tested until the End statement is reached. See below.

                    If endOfProcedure <> 0 And startOfProcedure < endOfProcedure And i > endOfProcedure Then
                        GoTo NextLine
                    End If

                    If i = bodyOfProcedure Then inprocbodylines = True

                    If bodyOfProcedure < i And i < startOfProcedure + countOfProcedure Then
                        If Not (.Lines(i - 1, 1) Like "* _") Then

                            inprocbodylines = False

                            PreviousIndentAdded = 0

                            If Trim(strLine) = "" And Not AddLineNumbersToEmptyLines Then GoTo NextLine

                            If IsProcEndLine(wbName, vbCompName, i) Then
                                endOfProcedure = i
                                If AddLineNumbersToEndOfProc Then
                                    Call IndentProcBodyLinesAsProcEndLine(wbName, vbCompName, LabelType, endOfProcedure)
                                Else
                                    GoTo NextLine
                                End If
                            End If

                            If LabelType = vbLabelColon Then
                                If HasLabel(strLine, vbLabelColon) Then strLine = RemoveOneLineNumber(.Lines(i, 1), vbLabelColon)
                                If Not HasLabel(strLine, vbLabelColon) Then
                                    temp_strLine = strLine
                                    .ReplaceLine i, CStr(i) & ":" & strLine
                                    new_strLine = .Lines(i, 1)
                                    If Len(new_strLine) = Len(CStr(i) & ":" & temp_strLine) Then
                                        PreviousIndentAdded = Len(CStr(i) & ":")
                                    Else
                                        PreviousIndentAdded = Len(CStr(i) & ": ")
                                    End If
                                End If
                            ElseIf LabelType = vbLabelTab Then
                                If Not HasLabel(strLine, vbLabelTab) Then strLine = RemoveOneLineNumber(.Lines(i, 1), vbLabelTab)
                                If Not HasLabel(strLine, vbLabelColon) Then
                                    temp_strLine = strLine
                                    .ReplaceLine i, CStr(i) & vbTab & strLine
                                    PreviousIndentAdded = Len(strLine) - Len(temp_strLine)
                                End If
                            End If

                        Else
                            If Not inprocbodylines Then
                                If LabelType = vbLabelColon Then
                                    .ReplaceLine i, Space(PreviousIndentAdded) & strLine
                                ElseIf LabelType = vbLabelTab Then
                                    .ReplaceLine i, Space(4) & strLine
                                End If
                            Else
                            End If
                        End If

                    End If

                End If

    NextLine:
            Next i

    ElseIf AddLineNumbersToEmptyLines And Scope = vbScopeThisProc Then

    End If

            .CodePane.Window.Visible = True
        End With

    End Sub
              Function IsProcEndLine(ByVal wbName As String, _
                  ByVal vbCompName As String, _
                  ByVal Line As Long) As Boolean

    With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule
    If Trim(.Lines(Line, 1)) Like "End Sub*" _
                Or Trim(.Lines(Line, 1)) Like "End Function*" _
                Or Trim(.Lines(Line, 1)) Like "End Property*" _
                Then IsProcEndLine = True
    End With

    End Function
              Sub IndentProcBodyLinesAsProcEndLine(ByVal wbName As String, ByVal vbCompName As String, ByVal LabelType As vbLineNumbers_LabelTypes, ByVal ProcEndLine As Long)
        Dim procName As String
        Dim startOfProcedure As Long
        Dim endOfProcedure As Long

        With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule

            procName = .ProcOfLine(ProcEndLine, vbext_pk_Proc)
            bodyOfProcedure = .ProcBodyLine(procName, vbext_pk_Proc)
            endOfProcedure = ProcEndLine
            strEnd = .Lines(endOfProcedure, 1)

            j = bodyOfProcedure
            Do Until Not .Lines(j - 1, 1) Like "* _" And j <> bodyOfProcedure

                strLine = .Lines(j, 1)

                If LabelType = vbLabelColon Then
                    If Mid(strEnd, Len(CStr(endOfProcedure)) + 1 + 1 + 1, 1) = " " Then
                        .ReplaceLine j, Space(Len(CStr(endOfProcedure)) + 1) & strLine
                    Else
                        .ReplaceLine j, Space(Len(CStr(endOfProcedure)) + 2) & strLine
                    End If
                ElseIf LabelType = vbLabelTab Then
                    If endOfProcedure < 1000 Then
                        .ReplaceLine j, Space(4) & strLine
                    Else
                        Debug.Print "This tool is limited to 999 lines of code to work properly."
                    End If
                End If

                j = j + 1
            Loop

        End With
    End Sub
              Sub RemoveLineNumbers(ByVal wbName As String, ByVal vbCompName As String, ByVal LabelType As vbLineNumbers_LabelTypes)
        Dim i As Long
        With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule
            'MsgBox ("nr of lines = " & .CountOfLines & vbNewLine & "Procname = " & procName)
                'MsgBox ("nr of lines REMEMBER MUST BE LARGER THAN 7! = " & .CountOfLines)
            For i = 1 To .CountOfLines
                procName = .ProcOfLine(i, vbext_pk_Proc)
                If procName <> vbNullString Then
                    If i > 1 Then
                            'MsgBox ("Line " & i & " is a body line " & .ProcBodyLine(procName, vbext_pk_Proc))
                        If i = .ProcBodyLine(procName, vbext_pk_Proc) Then inprocbodylines = True
                            If .Lines(i - 1, 1) <> "" Then
                                'MsgBox (.Lines(i - 1, 1))
                            End If
                        If Not .Lines(i - 1, 1) Like "* _" Then
                            'MsgBox (inprocbodylines)
                            inprocbodylines = False
                                'MsgBox ("recoginized a line that should be substituted: " & i)
                            'MsgBox ("about to replace " & .Lines(i, 1) & vbNewLine & " with: " & RemoveOneLineNumber(.Lines(i, 1), LabelType) & vbNewLine & " with label type: " & LabelType)
                            .ReplaceLine i, RemoveOneLineNumber(.Lines(i, 1), LabelType)
                        Else
                            If IsInProcBodyLines Then
                                ' do nothing
                                    'MsgBox (i)
                            Else
                                .ReplaceLine i, Mid(.Lines(i, 1), RemovedChars_previous_i + 1)
                            End If
                        End If
                    End If
                Else
                ' GoTo NextLine
                End If
    NextLine:
            Next i
        End With
    End Sub
              Function RemoveOneLineNumber(ByVal aString As String, ByVal LabelType As vbLineNumbers_LabelTypes)
        RemoveOneLineNumber = aString
        If LabelType = vbLabelColon Then
            If aString Like "#:*" Or aString Like "##:*" Or aString Like "###:*" Or aString Like "####:*" Then
                RemoveOneLineNumber = Mid(aString, 1 + InStr(1, aString, ":", vbTextCompare))
                If Left(RemoveOneLineNumber, 2) Like " [! ]*" Then RemoveOneLineNumber = Mid(RemoveOneLineNumber, 2)
            End If
        ElseIf LabelType = vbLabelTab Then
            If aString Like "#   *" Or aString Like "##  *" Or aString Like "### *" Or aString Like "#### *" Then RemoveOneLineNumber = Mid(aString, 5)
            If aString Like "#" Or aString Like "##" Or aString Like "###" Or aString Like "####" Then RemoveOneLineNumber = ""
        End If
    End Function
              Function HasLabel(ByVal aString As String, ByVal LabelType As vbLineNumbers_LabelTypes) As Boolean
        If LabelType = vbLabelColon Then HasLabel = InStr(1, aString & ":", ":") < InStr(1, aString & " ", " ")
        If LabelType = vbLabelTab Then
            HasLabel = Mid(aString, 1, 4) Like "#   " Or Mid(aString, 1, 4) Like "##  " Or Mid(aString, 1, 4) Like "### " Or Mid(aString, 1, 5) Like "#### "
        End If
    End Function
              Function RemoveLeadingSpaces(ByVal aString As String) As String
        Do Until Left(aString, 1) <> " "
            aString = Mid(aString, 2)
        Loop
        RemoveLeadingSpaces = aString
    End Function
              Function WhatIsLineIndent(ByVal aString As String) As String
        i = 1
        Do Until Mid(aString, i, 1) <> " "
            i = i + 1
        Loop
        WhatIsLineIndent = i
    End Function

              Function HowManyLeadingSpaces(ByVal aString As String) As String
        HowManyLeadingSpaces = WhatIsLineIndent(aString) - 1
    End Function

Module3:

    Global allow_for_line_addition As String 'this is just so that you can automatically add linenumbers
            Sub remove_line_numbering_all_modules()
    'source: https://stackoverflow.com/questions/36791473/vba-getting-the-modules-in-workbook
    'This code numbers all the modules in your .xlsm
        Dim vbcomp As VBComponent
        Dim modules As Collection
    Set modules = New Collection
        For Each vbcomp In ThisWorkbook.VBProject.VBComponents
            'if normal or class module
            If ((vbcomp.Type = vbext_ct_StdModule) Or (vbcomp.Type = vbext_ct_ClassModule)) Then
                   'V0:
                   RemoveLineNumbers wbName:=ThisWorkbook.name, vbCompName:=vbcomp.name, LabelType:=vbLabelColon
                   'V1:
                   'Call RemoveLineNumbers(ThisWorkbook.name, vbcomp.name)
            End If
        Next vbcomp
    End Sub

Module4:

    Global allow_for_line_addition As String 'this is just so that you can automatically add linenumbers
    'This sub adds line numbers to all the modules after you have added the following line to every module
    'add tools references microsoft visual basic for applications (5.3) as checked
    'Source httpsstackoverflow.comquestions40731182excel-vba-how-to-turn-on-line-numbers-in-code-editor50368332#50368332
            Sub add_line_numbering_all_modules()
    'source: https://www.stackoverflow.com/questions/36791473/vba-getting-the-modules-in-workbook
    'This code numbers all the modules in your .xlsm
        Dim vbcomp As VBComponent
        Dim modules As Collection
        Set modules = New Collection
        For Each vbcomp In ThisWorkbook.VBProject.VBComponents
            'if normal or class module
            If ((vbcomp.Type = vbext_ct_StdModule) Or (vbcomp.Type = vbext_ct_ClassModule)) Then
                   'V0:
                   Call AddLineNumbers(ThisWorkbook.name, vbcomp.name, vbLabelColon, True, True, vbScopeAllProc)
                   'v1
                   'Call AddLineNumbers(ThisWorkbook.name, vbcomp.name)
            End If
        Next vbcomp
    End Sub

where you can either substitute "Book1.xlsm" with the name of your own workbook, or with thisworkbook (notice no ""), or vice versa.

  • *Note this worked in excel 2016, I have not tried it in 2013 yet.
  • ^It is a modified version of Hemced's answer here., which in turn, looks a lot like Arich's answer.
  • °because sometimes you get an error if you cut lines out or move them around (e.g. put line 2440: above line 2303:). By removing and re-adding them, the line numbering is automatically correct again.


来源:https://stackoverflow.com/questions/35459541/adding-line-numbers-to-vba-code-microsoft-access-2016

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!