Excel VBA - Как включить номера строк в редакторе кода

Question

Пожалуйста, помогите: как включить номера строк в редакторе кода Excel VBA? Я использую версию Excel 2013.

Спасибо.

Answer 1

Вот мой код для добавления номеров строк в VBE IDE. Это улучшение решения, предоставленного здесь Excel MVP mikerickson. Я работал над этим, потому что в некоторых редких случаях, которые я уже встречал, VBE не может войти в режим отладки, например, когда у вас есть метод.ReplaceLine в вашем коде. Действительно, вы не можете войти в режим отладки после того, как он был выполнен, поэтому Erl может быть полезен для отладки (вместо Debug.Print). Я добавил несколько функций, таких как:

• Возможность добавления номеров строк в качестве меток: 10: Dim foo as bar или как отдельные числа, отделенные от кода вкладкой: 10 Dim foo as bar
• возможность добавлять номера строк в операторы End процедуры и сопоставлять отступ строк объявления процедуры с его строкой оператора End после нумерации. Или нет.
• возможность добавлять номера строк в пустые строки или нет
• [WIP] возможность добавлять номера строк к определенной процедуре в модуле
• [WIP] сопоставляет все отступы строк кода с номерами строк, чтобы соответствовать отступу последней строки с отступом. Если последняя строка 200: End Sub, линия 30: With ActiveSheet будет переопределен как 30: ActiveSheet
• [WIP] добавление команды VBE IDE для непосредственного выполнения вызовов с текущим модулем / процедурой в качестве параметра

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

Вы можете звонить так:

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

И как напоминание, вот некоторые правила компиляции о номерах строк:

• не допускается до оператора объявления Sub/Function
• не допускается вне процедуры
• не допускается в строке после символа продолжения строки "_" (подчеркивание)
• не допускается иметь более одного номера метки / строки на строку кода ~~> Необходимо проверить существующие метки, кроме номеров строк, в противном случае произойдет ошибка компиляции при попытке форсировать номер строки.
• не разрешается использовать символы, которые уже имеют специальный VBA, означающий ~~> Допустимые символы: [aZ], [0-9], é, è, ô, ù, €, £, § и даже ":" в одиночку!
• компилятор обрежет любой пробел перед меткой ~~> Так что если есть метка, первый символ строки является первым символом метки, он не может быть пробелом.
• добавление номера строки с двоеточием приведет к вставке пробела между ":" и первым символом кулака, если его нет
• при добавлении номера строки с табуляцией / пробелом, между последней цифрой и первым следующим символом должен быть хотя бы один пробел, компилятор не будет добавлять его, как для метки с разделителем двоеточий
• метод.ReplaceLine переопределяет правила компиляции без отображения ошибки компиляции, как это происходит в режиме конструктора при выборе новой строки или при повторном запуске компиляции вручную.
• компилятор "быстрее, чем среда / система VBA": например, сразу после вставки номера строки с двоеточием и без пробела с помощью.ReplaceLine, если свойство.Lines вызывается для получения новой строки, пробел (между двоеточием и первым символом строки) уже добавлен в эту строку!
• невозможно войти в режим отладки после вызова.ReplaceLine (изнутри или снаружи модуля, который он редактирует), не до тех пор, пока код не будет запущен, и выполнение не будет сброшено.

Answer 2

Краткий ответ за excel 2016, еще не пробовал в 2013 году.

Сделать один раз:

1. Вставьте большой код из финала Module2 в этом ответе в вашей рабочей тетради.
2. Вставьте код для финала Module3 в этом ответе, в вашей рабочей тетради.
3. Вставьте код для финала Module4 в этом ответе, в вашей рабочей тетради.
4. Затем вставьте строку Global allow_for_line_addition As Stringэто просто для того, чтобы вы могли автоматически добавлять бельё выше / в первой строке каждого модуля.
5. Удалите все пустые строки в конце каждого модуля (чтобы не было потерь после последнего end sub,end function или же End Property модуля).
6. В редакторе VBA, когда код не запущен и не находится в режиме "break": щелкните инструменты> ссылки>mark: `Microsoft Visual Basic для приложений Extensibility 5.3"

Делайте каждый раз, когда вы изменили свой код:

7. * Запустите код для финала Module3 удалить номера строк для всех модулей в вашей книге.
8. * Запустите код для финала Module4 добавить номера строк для всех модулей в вашей книге.

(* потому что иногда вы получаете ошибку, если вырезаете линии или перемещаете их (например, ставите line 2440: выше line 2303:). При удалении и повторном добавлении нумерация строк снова автоматически корректируется)

Длинный ответ (включая шаги и попытки обучения) - мне было нелегко реализовать ответ hymced, поэтому я задокументировал шаги, необходимые для добавления номеров строк в модуль в редакторе кода VBA (* и удалил их снова). Я следовал за следующими шагами, чтобы заставить это работать.

10. Из этой ссылки я узнал, что vbcomponent может быть модулем.
11. Я скопировал первый данный код во временный Module2и второй код, заданный hymced во временный Module3,

12. Затем изменили первую строку 2-го кода во временном Module3 чтобы:

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

13. Я получил ошибку в строке:

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

14. Поэтому я прочитал, что мне нужно было включить библиотеку VBIDE.

15. Поэтому я остановил код, щелкнул инструменты> ссылки и не смог найти библиотеку VBIDE.

16. На этом форуме я обнаружил, что VBIDE включен, добавив ссылку на библиотеку расширяемости VBA:

Нажмите Инструменты-Ссылки в VBE, прокрутите вниз и отметьте запись для Microsoft Visual Basic для расширений приложений 5.3.

Таким образом, после этого первая ошибка исчезла, и она не выделила ни одной строки, но выдавала ошибку "Недопустимый вызов процедуры или аргумент".

1. Так как я все еще не уверен насчет vbCompName, я подумал, что ему может понадобиться знать sub вместо модуля, поэтому я попытался изменить второй код во временном Module3 чтобы:

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

2. Это выделило строку:

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

говоря: subscript out of range, (Поэтому я тоже попробовал: Module1.learn а также Module1:learn, уступая subscript out of range-ошибка.

Как выясняется,

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

является правильным способом вызова заменяющего подпрограммы, если подпрограмма, которой вы хотите предоставить номера строк, находится в модуле с именем Module1, Первая описанная ошибка возникает, но она добавляет номера строк в код (за исключением первой строки, содержащей sub ... и последняя строка, содержащая end sub. Испытано в Module1 названный sub learn() книги Excel 2016 назван Book1.xlsm, Для полноты learn состоит из:

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

Однако на обратном пути, удалив номера строк, он выдал ошибку, потому что спрашивает.lines(0,1) procName в Sub AddLineNumbers...

1. Поэтому я изменил его, чтобы исключить.lines(0,1), поместив измененный код ниже в финал 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
   

С вызовом замены на sub learn() с кодом ниже, вставленным во временный 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

Теперь это сработало (добавление и удаление номеров строк, все 4 метода вызова добавления / удаления номеров строк вставлены во временные module2 для одного саба в модуле (module1 в примере кейса). Поэтому я попытался поставить 2 саба друг за другом в том же модуле. В этом случае код не изменил добавленные номера строк во 2-й подпункт.

1. Поэтому я добавил следующую строку выше Module1:

   Global allow_for_line_addition As String
   

Изготовление Module1 выглядит как:

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

Теперь он добавил номера строк ко всему модулю, но не удалил номера строк всего модуля, поэтому я отредактировал код удаления hymceds answer as well and already put it in the long code of **final**Module2`.

Примечание. Если у вас есть пустые белые строки после конца подпрограммы или функции, они будут продолжать добавлять белые строки каждый раз, когда вы запускаете скрипт для добавления номеров строк (который после первого запуска просто обновляет номера строк). Эти пустые номера строк вызывают ошибку при выполнении кода, поэтому вы должны удалить их один раз. Если в конце подпрограммы нет пустых строк, этот код также не будет добавлять новые.

1. Чтобы добавить номера строк во все ваши модули в книге, сохраните длинный код в окончательном виде. Module2 как я его модифицировал и заменил временный кодModule3 с финалом 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://stackru.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
   

   И добавьте следующий код в 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 httpsstackru.comquestions40731182excel-vba-how-to-turn-on-line-numbers-in-code-editor50368332#50368332
           Sub add_line_numbering_all_modules()
   'source: https://www.stackru.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
   

где вы можете заменить "Book1.xlsm" с названием вашей рабочей книги или с thisworkbook (обратите внимание, нет ""), или наоборот.

Answer 3

Простое решение:

• Нажмите CTRL+A в редакторе VBA и скопируйте весь свой код.
• Перейдите в новый документ Word и пройдите кодировку.
• На ленте выберите «Макет», а затем «Нумерация строк».
• Выберите «непрерывный»

Вуаля Номера строк в вашей кодировке ;-)