Excel VBA - How to Turn On Line Numbers in Code Editor

前端未结

关注

 2  1973

死守一世寂寞

Please kindly help: how do I turn on the line numbers in Excel VBA code editor? I am using Excel 2013 version.

Thank you.

相关标签:

2条回答

执笔经年

2020-12-16 15:24

Here is my code to add line numbers in the VBE IDE. It is an improvement of the solution provided here by Excel MVP mikerickson. I have worked on this, because in some rare cases I have already met, VBE can't enter in debug mode, for example when you have a .ReplaceLine method in your code. Indeed, you can't enter in debug mode once it has been executed, so Erl might be usefully for debug (instead of Debug.Print). I have added several feature such as:

possibility to either add line numbers as labels: 10: Dim foo as bar or as single numbers seperated from code by a tab: 10 Dim foo as bar

possibility to add line numbers to End of procedures statements, and to match the indent of the procedure declaration lines to its End statement line once numberered. Or not.

possibility of add line numbers to empty lines or not

[WIP] possibility to add line numbers to a specific procedure in a module

[WIP] match all indentations of code lines with line numbers to match the indent of the last line indented. If last line is 200: End Sub, the line 30: With ActiveSheet will be re-indented as 30: ActiveSheet

[WIP] add of a VBE IDE command to directly make the calls with the current module/proc as a parameter

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

            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

        For i = 1 To .CountOfLines

            procName = .ProcOfLine(i, vbext_pk_Proc)

            If procName <> vbNullString Then

                If i = .ProcBodyLine(procName, vbext_pk_Proc) Then InProcBodyLines = True

                LenghtBefore = Len(.Lines(i, 1))
                If Not .Lines(i - 1, 1) Like "* _" Then
                    InProcBodyLines = False
                    .ReplaceLine i, RemoveOneLineNumber(.Lines(i, 1), LabelType)
                Else
                    If IsInProcBodyLines Then
                        ' do nothing
                    Else
                        .ReplaceLine i, Mid(.Lines(i, 1), RemovedChars_previous_i + 1)
                    End If
                End If
                LenghtAfter = Len(.Lines(i, 1))

                LengthBefore_previous_i = LenghtBefore
                LenghtAfter_previous_i = LenghtAfter
                RemovedChars_previous_i = LengthBefore_previous_i - LenghtAfter_previous_i

                If Trim(.Lines(i, 1)) Like "End Sub*" Or Trim(.Lines(i, 1)) Like "End Function" Or Trim(.Lines(i, 1)) Like "End Property" Then

                    LenOfRemovedLeadingCharacters = LenghtBefore - LenghtAfter

                    procName = .ProcOfLine(i, vbext_pk_Proc)
                    bodyOfProcedure = .ProcBodyLine(procName, vbext_pk_Proc)

                    j = bodyOfProcedure
                    strLineBodyOfProc = .Lines(bodyOfProcedure, 1)
                    Do Until Not strLineBodyOfProc Like "* _"
                        j = j + 1
                        strLineBodyOfProc = .Lines(j, 1)
                    Loop
                    LastLineBodyOfProc = j
                    strLastLineBodyOfProc = strLineBodyOfProc

                    strLineEndOfProc = .Lines(i, 1)
                    For k = bodyOfProcedure To j
                        .ReplaceLine k, Mid(.Lines(k, 1), 1 + LenOfRemovedLeadingCharacters)
                    Next k

                    i = i + (j - bodyOfProcedure)
                    GoTo NextLine

                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 "###:*" 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 "### *" Then RemoveOneLineNumber = Mid(aString, 5)
        If 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 "### "
    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

You can make calls like this :

Sub AddLineNumbers_vbLabelColon()
    AddLineNumbers wbName:="EvaluateCall.xlsm", vbCompName:="ModLineNumbers_testDest", LabelType:=vbLabelColon, AddLineNumbersToEmptyLines:=True, AddLineNumbersToEndOfProc:=True, Scope:=vbScopeAllProc
End Sub

Sub AddLineNumbers_vbLabelTab()
    AddLineNumbers wbName:="EvaluateCall.xlsm", vbCompName:="ModLineNumbers_testDest", LabelType:=vbLabelTab, AddLineNumbersToEmptyLines:=True, AddLineNumbersToEndOfProc:=True, Scope:=vbScopeAllProc
End Sub

Sub RemoveLineNumbers_vbLabelColon()
    RemoveLineNumbers wbName:="EvaluateCall.xlsm", vbCompName:="ModLineNumbers_testDest", LabelType:=vbLabelColon
End Sub

Sub RemoveLineNumbers_vbLabelTab()
    RemoveLineNumbers wbName:="EvaluateCall.xlsm", vbCompName:="ModLineNumbers_testDest", LabelType:=vbLabelTab
End Sub

And as a reminder, here as some compile rules about about line numbers:

not allowed before a Sub/Function declaration statement
not allowed outside of a proc
not allowed on a line following a line continuation character "_" (underscore)
not allowed to have more than one label/line number per code line ~~> Existing labels other than line numbers must be tested otherwise a compile error will occur trying to force a line number.
not allowed to use characters that already have a special VBA meaning ~~> Allowed characters are [a-Z], [0-9], é, è, ô, ù, €, £, § and even ":" alone !
compiler will trim any space before a label ~~> So if there is a label, the first char of the line is the first char of the label, it cannot be a space.
appending a line number with a colon will result in having a space inserted between the ":" and the fist next char if there is none
when appending a line number with a tab/space, there must be at least one space between the last digit and the first next char, compiler won't add it as it does for a label with a colon separator
the .ReplaceLine method will overide the compile rules without displaying any compile error as it does in design mode when selecting a new line or when manually relaunching compilation
the compiler is 'quicker than the VBA environment/system': for example, just after a line number with colon and without any space has been inserted with .ReplaceLine, if the .Lines property is called to get the new string, the space (between the colon character and the first character of the string) is already appended in that string !
it is not possible to enter debug mode after a .ReplaceLine has been called (from within or outside the module it is editting), not till the code is running, and execution reset.

0 讨论(0)

星月不相逢

2020-12-16 15:31

Short answer for excel 2016, have not tried it in 2013 yet.

Do Once:

Paste the large code from final Module2 in this answer in your workbook.
Paste the code for final Module3 in this answer, in your workbook.
Paste the code for final Module4 in this answer, in your workbook.
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.
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).
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:

*Run the code for final Module3 to remove line numbers to all the modules in your workbook.
*Run the code for final Module4 to add line numbers to all the modules in your workbook.

(*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)

Long answer (including learning steps and attempts) - to me it was not straightforward to implement hymced`s answer, so I documented the steps necessary to add line numbers to a module in the VBA code editor (*and remove them again). I followed the following steps to get it working.

From this link I have learned that a vbcomponent can be a module.
I Copyied the first code given, into temporary Module2, and the second code given by hymced into temporary Module3.

Then modified the first line of the 2nd code in temporary Module3 to:

AddLineNumbers wbName:="Book1.xlsm", vbCompName:="Module1", LabelType:=vbLabelColon, AddLineNumbersToEmptyLines:=True, AddLineNumbersToEndOfProc:=True, Scope:=vbScopeAllProc

I got an error at line:

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

So I read I had to enable the VBIDE library.
So I stopped the code, clicked tools>references, and could not find the VBIDE library.
On this forum I found the VBIDE is enabled by adding a reference to the VBA extensibility library:

Click on Tools-References in the VBE, and scroll down and tick the entry for Microsoft Visual Basic for Applications Extensibility 5.3.

So after doing that the first error disapeared and it did not highlight any line but gave the it gave the error "Invalid procedure call or argument".

Since I am still not sure about the vbCompName, I thought it might need to know the sub in stead of the module so I tried to modify the 2nd code in temporary Module3 to:

AddLineNumbers wbName:="Book1.xlsm", vbCompName:="learn", LabelType:=vbLabelColon, AddLineNumbersToEmptyLines:=True, AddLineNumbersToEndOfProc:=True, Scope:=vbScopeAllProc

That highlighted the line:

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

saying: subscript out of range. (So I also tried: Module1.learn and Module1:learn, yielding the subscript out of range-error.

As it turns out,

AddLineNumbers wbName:="Book1.xlsm", vbCompName:="Module1", LabelType:=vbLabelColon, AddLineNumbersToEmptyLines:=True, AddLineNumbersToEndOfProc:=True, Scope:=vbScopeAllProc

is the right way to call the replacing sub if the sub you want to provide with line numbers is located in a module named Module1. The first error describes occurs, but it does add the line numbers to the code (except for first line containing sub ... and the last line containing end sub.Tested in Module1 named sub learn() of the excel 2016 workbook named Book1.xlsm. For completeness learn consists of:

Sub learn()
    ThisWorkbook.Worksheets("Sheet1").Activate
    Range("A1").Activate
    Range("A1").Select
    Range("A1").Value = Range("A1").Value + 1
End Sub

However, on the way back, removing the line numbers, it yielded an error because it asks .lines(0,1) of procName in Sub AddLineNumbers...

So I modified it to exclude the .lines(0,1) by putting the changed code below into final 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

With calling the replacement on sub learn() with the code below, pasted in temporary module3:

    Sub AddLineNumbers_vbLabelColon()
    AddLineNumbers wbName:="Book1.xlsm", vbCompName:="Module1", LabelType:=vbLabelColon, AddLineNumbersToEmptyLines:=True, AddLineNumbersToEndOfProc:=True, Scope:=vbscopeallproc
End Sub

Sub AddLineNumbers_vbLabelTab()
    AddLineNumbers wbName:="Book1.xlsm", vbCompName:="Module1", LabelType:=vbLabelTab, AddLineNumbersToEmptyLines:=True, AddLineNumbersToEndOfProc:=True, Scope:=vbscopeallproc
End Sub

Sub RemoveLineNumbers_vbLabelColon()
    RemoveLineNumbers wbName:="Book1.xlsm", vbCompName:="Module1", LabelType:=vbLabelColon
End Sub

Sub RemoveLineNumbers_vbLabelTab()
    RemoveLineNumbers wbName:="Book1.xlsm", vbCompName:="Module1", LabelType:=vbLabelTab
End Sub

Now it worked (both adding and removing line numbers, with all 4 methods of calling the adding/removal of line numbers pasted in temporary module2 for a single sub in a module (module1 in the example case). So I tried to put 2 subs behind eachother in the same module. In that case, the code did not change the add line numbers to the 2nd sub.

So I added the following line above Module1:
```
Global allow_for_line_addition As String
```

Making Module1 look like:

Global allow_for_line_addition As String
  Sub learn()
    ThisWorkbook.Worksheets("Sheet1").Activate
    Range("A1").Activate
    Range("A1").Select
    Range("A1").Value = Range("A1").Value + 1
End Sub
Sub learn2()
    ThisWorkbook.Worksheets("Sheet1").Activate
    Range("A1").Activate
    Range("A1").Select
    Range("A1").Value = Range("A1").Value + 1
End Sub

Now it added the line numbers to the entire module, but it did not remove the line numbers from the entire module, so I edited the removal code of hymceds answer as well and already put it in the long code of **final**Module2`.

Note: If you have empty white lines after the end of a sub or function, it will keep on adding white lines every time you run the script to add the line numbers (which after the first run, simply updates the line numbers). These empty line numbers cause an error when executing the code, so you should remove them once. If there are no empty lines at the end of a sub, this code will also not add new ones.

To add line numbers to all of your modules in your workbook, keep the long code in final Module2 as I modified it and replace the code of temporary Module3 with final 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

And add the following code to final 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.

0 讨论(0)