Vba excel нумерация строк кода

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.
Источник

Инструмент нумерации строк кода — производит автоматическую нумерацию строк кода

Данный инструмент используется для отслеживания номера строки кода, в которой возникла ошибка, с последующей записью её в LOG – файл. Без нумерации строк кода отследить место возникновения ошибки и ее трассирование не возможно.

Рекомендуется использовать совместно с инструментом – “ЛОГИРОВАНИЕ”

Расстановка/удаление нумерации строк кода:

    • автоматическое удаление нумерации строк кода
    • автоматическая нумерация строк кода

Рекомендация
После использования инструмента производите проверку работоспособности вашего кода, инструментом: Debug -> Compile VBAProject. Который расположен на панели управления редактора VBE

Нумерация строк кода

Нумерация строк кода в редакторе кода VBE

Пример использования:

   Public Sub NumberingExample(ByVal url_str As String)
2:     On Error GoTo ErrorHandler
3:     '< - Ваш код процедуры - >
4:     Exit Sub
ErrorHandler:
6:     Select Case Err
7:         Case Else:
8:         Call MsgBox("Произошла ошибкав NumberingExample" & "в строке " & Erl, _
9:                     vbOKOnly + vbCritical, "Ошибка в NumberingExample")
10:        '< - оператор Erl, выводит номер строки с ошибкой без нумерации строк не работает
11:        Call WriteErrorLog("NumberingExample") '< - инструмент "ЛОГИРОВАНИЕ"
12:    End Select
13:    Err.Clear
14:End Sub

Источник

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

Спасибо.

2016-11-21 23:17

2

ответа

Вот мой код для добавления номеров строк в 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 (изнутри или снаружи модуля, который он редактирует), не до тех пор, пока код не будет запущен, и выполнение не будет сброшено.

2017-03-27 12:06

Краткий ответ за 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″

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

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

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

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

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

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

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

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

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

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

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

  7. На этом форуме я обнаружил, что 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 (обратите внимание, нет «»), или наоборот.

2018-05-16 10:22

Источник
 

Hashtag

Пользователь

Сообщений: 145
Регистрация: 05.02.2019

#1

08.02.2019 15:48:43

Добрый день. Помогите создать нумерацию не пустых строк средствами VBA, без формул в ячейках. Нумерация должна начинаться с 7 строки в колонке B. При очистке строки нумерация в строке должна удаляться и продолжить нумерацию со следующей не пустой строки.
Имеющийся код начинает нумеровать с первой строки и не очищает значения с последующим продолжением нумерации.

Код 
Application.EnableEvents = False
   RowMax = Cells.SpecialCells(xlCellTypeLastCell).Row
   ColMax = Cells.SpecialCells(xlCellTypeLastCell).Column
   n = 0
   For i = 1 To RowMax
      For j = 1 To ColMax
         If Not IsEmpty(Cells(i, j)) Then
            n = n + 1
            Cells(i, 2) = n
            Exit For
         End If
      Next j
   Next i
Application.EnableEvents = True

Прикрепленные файлы

  • Пример.xlsm (25.33 КБ)
 

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

#2

08.02.2019 16:03:35

Код 
Sub RenumB()
  Dim b As Range, c As Range, i&, r&
  For r = 1 To Cells.SpecialCells(xlCellTypeLastCell).Row
    If WorksheetFunction.CountBlank(Rows(r)) < Columns.Count Then If b Is Nothing Then Set b = Cells(r, 2) Else Set b = Union(b, Cells(r, 2))
  Next
  i = 1
  For Each c In b
    c = i: i = i + 1
  Next
End Sub

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

 

vikttur

Пользователь

Сообщений: 47199
Регистрация: 15.09.2012

#3

08.02.2019 16:06:39

Цитата
Hashtag написал: не очищает значения с последующим продолжением нумерации

Событие листа…
 

Hashtag

Пользователь

Сообщений: 145
Регистрация: 05.02.2019

#4

08.02.2019 19:33:11

Ігор Гончаренко
vikttur
Не удаляется нумерация в очищенной от записей строке. Также, при попытке очистить всю нумерацию выдает «Run-time error 424  Object required»? а в коде выделяется строка For Each c In b

Посмотрите, пожалуйста, что в коде не так?

Скрытый текст

Прикрепленные файлы

  • Пример2.xlsm (25.96 КБ)

Изменено: Hashtag — 08.02.2019 19:36:13
 

Vintic

Пользователь

Сообщений: 10
Регистрация: 14.01.2018

#5

08.02.2019 19:44:16

Код 
Sub num()
lr = Cells(Rows.Count, 3).End(xlUp).Row
Range(Cells(1, 1), Cells(lr, 1)).Clear
For i = 7 To lr
    If Application.WorksheetFunction.CountA(Rows(i)) <> 0 Then
        k = k + 1
        Cells(i, 1) = k
    End If
Next i
End Sub
 

Hashtag

Пользователь

Сообщений: 145
Регистрация: 05.02.2019

Vintic
Почти работает! Но если очищать строку с конца списка, например, последнюю строку, то номер строки не удаляется.
 

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

Файл не смотрел… Попробуйте увеличить переменную номера последней строки на единичку:
lr = Cells(Rows.Count, 3).End(xlUp).Row +1
 

Vintic

Пользователь

Сообщений: 10
Регистрация: 14.01.2018

#8

08.02.2019 21:25:38

Подлечил немного) Надеюсь сейчас все нормально

Код 
Sub num()
lr = Cells(Rows.Count, 3).End(xlUp).Row
Range(Cells(1, 1), Cells(lr + 1, 1)).Clear
For i = 7 To lr
    If Application.WorksheetFunction.CountA(Rows(i)) <> 0 Then
        k = k + 1
        Cells(i, 1) = k
    End If
Next i
End Sub
 

Vintic

Пользователь

Сообщений: 10
Регистрация: 14.01.2018

#9

08.02.2019 21:27:45

Цитата
Юрий М написал:
Попробуйте увеличить переменную номера последней строки на единичку

Спасибо, сделал почти так же
 

Hashtag

Пользователь

Сообщений: 145
Регистрация: 05.02.2019

#10

08.02.2019 21:28:43

Юрий М

Цитата
lr = Cells(Rows.Count, 3).End(xlUp).Row +1

Если снизу очищать несколько строк, номера остаются кроме одного
 

см.вложение

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

 

Hashtag

Пользователь

Сообщений: 145
Регистрация: 05.02.2019

Vintic
Тоже самое. Если очищать несколько строк снизу, все номера напротив, кроме одного, остаются.
 

Hashtag

Пользователь

Сообщений: 145
Регистрация: 05.02.2019

Ігор Гончаренко
В вашем примере ни один номер, к сожалению, автоматически не удаляется, вариант Vintic сейчас ближе всего к правде.
 

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

#14

08.02.2019 21:56:22

Цитата
Hashtag написал:
Если снизу очищать несколько строк

В каких ячейках (столбцах) Вы удаляете значения?
 

Hashtag

Пользователь

Сообщений: 145
Регистрация: 05.02.2019

Юрий М
В этом примере очистите диапазон C18:F21 и C7:F10. Сверху номера автоматом удаляются, снизу — нет. Код от Vintic.

Изменено: Hashtag — 08.02.2019 22:04:01
 

skais675

Пользователь

Сообщений: 2177
Регистрация: 03.06.2014
 

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

#17

08.02.2019 22:37:52

Код 
lr = Cells(Rows.Count, 1).End(xlUp).Row
 

Hashtag

Пользователь

Сообщений: 145
Регистрация: 05.02.2019

skais675
Если снизу или сверху очищать строки, номера удаляются хорошо.
1.Но теперь если очищать снизу колонку C, номера удаляются, а должны удаляться только при полностью очищенной строке в диапазоне C:F.
2.При копировании кнопкой не происходит нумерация, если не заполнена ячейка C3, но должна происходить, даже если заполнена любая ячейка в диапазоне C:F.
 

ocet p

Пользователь

Сообщений: 438
Регистрация: 24.03.2018

#19

09.02.2019 01:38:10

Пожалуйста, проверьте:

Код 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim maks As Long, stk As Long, strk
    ReDim strk(1 To 5)
    For stk = 3 To 6
        strk(stk - 1) = Cells(Rows.Count, stk).End(xlUp).Row
    Next
    strk(1) = Cells(Rows.Count, 1).End(xlUp).Row
    maks = Application.Max(strk)
    If Intersect(Target, Range("c7:f" & maks)) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If maks <= 7 And Application.CountA(Range("c7:f7")) = 0 Then
        Range("a7").ClearContents: GoTo konets
    Else
        Range("a7:a" & maks).ClearContents
    End If
    strk = Empty
    stk = 0
    For Each strk In Range("c7:f" & maks).Rows
        If Application.CountA(strk) > 0 Then
            stk = stk + 1
            Range("a" & strk.Row).Value = stk
        End If
    Next
konets: Application.EnableEvents = True
End Sub
 

skais675

Пользователь

Сообщений: 2177
Регистрация: 03.06.2014

Ну раз такое дело, тогда так.
 

Hashtag

Пользователь

Сообщений: 145
Регистрация: 05.02.2019

#21

09.02.2019 13:32:11

skais675
Все безупречно, спасибо вам огромное.
ocet p
Не удалось проверить ваш код, постоянно была ошибка в этом месте:

Код 
If Intersect(Target, Range("c7:f" & maks)) Is Nothing Then

От себя хочу поблагодарить всех, кто отозвался решить эту задачу и внес свой вклад в ее разрешение, не оставили наедине с проблемой и довели дело до конца. Спасибо всем!
 

vikttur

Пользователь

Сообщений: 47199
Регистрация: 15.09.2012

#22

09.02.2019 13:39:15

Цитата
Hashtag написал: ocet p Не удалось проверить ваш код

Код в модуле листа? Нужно показать, тогда и на ошибку укажут.
 

Hashtag

Пользователь

Сообщений: 145
Регистрация: 05.02.2019

#23

09.02.2019 14:16:43

vikttur

Цитата
Код в модуле листа? Нужно показать, тогда и на ошибку укажут.

Если в модуле листа, ошибку не выдает, но и нумерация не происходит.

Прикрепленные файлы

  • Пример4.xlsm (23.55 КБ)
 

vikttur

Пользователь

Сообщений: 47199
Регистрация: 15.09.2012

#24

09.02.2019 14:22:01

Код 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = 0
Call num

Название процедуры указывает на то, что это — процедура отслеживания события листа (Worksheet_Change) — код должен быть в модуле листа.
Последняя показанная строка — переход к выпонению макроса  num. Да, он у Вас есть… но пустой.

По коду Worksheet_Change. Вы изменили предложенный макрос.

Код 
 If Intersect(Target, Range("C3:F3")) Is Nothing Then Exit Sub

Если изменения произошли не в диапазоне C3:F3, уходим. Т.е. до проверки диапазона Range(«c7:f» & maks) никак не дойдет

Это вообще лишнее:

Код 
  Application.EnableEvents = Truе 
  Application.EnableEvents = False
 

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

Hashtag, в #17 я предложил минимальную правку (к старым файлам), которая решала проблему.
 

Hashtag

Пользователь

Сообщений: 145
Регистрация: 05.02.2019

#26

09.02.2019 17:06:07

vikttur
Вы правы, вариант от ocet p работает.

Прикрепленные файлы

  • Пример5.xlsm (22.1 КБ)
Источник

Надстройка: Macro Tools VBA – инструменты разработки макросов VBATools

Цели данного блога:

1. распространение надстройки MacroToolsVBA
2. улучшение функционала (исправление ошибок, внедрение новых функции)

Основные преимущества Macro Tools VBA:

• установка, не требующая от пользователя прав администратора
• открытый исходный код
• работает на версиях MS Excel 32 bit и 64 bit
• русскоязычный интерфейс
• бесплатная

Основные функции Macro Tools VBA:

• удаление паролей с проектов VBA, книг и листов Excel
• автоматическое форматирование кода, расстановка и удаление отступов в коде (функционал надстройки: Smart Indenter)
• автоматическая нумерации строк кода
• микро подстройка элементов в формах
• переименование элементов в формах одновременно с кодом
• обфускация кода в проекте VBA
• выдавать подробную статистику по проекту (кол-во строк кода, процедур, элементов на формах и т.д.)
• имеет свою базу заготовок кода (Code-Library), для типичных случаев с быстрой вставкой в новых макросах
• возможность дополнить Code-Library своими заготовками кода
• автоматическая распаковка и запаковка файла Excel

Файл для установки находится тут: Macro Tools VBA – инструменты разработки макросов VBATools.ru

Подпишитесь на нас в контакте что бы не пропустить важных обновлений https://vk.com/vbatools

Источник

Like this post? Please share to your friends:
  • Vba excel нумерация страниц
  • Vba excel номер строки по значению ячейки
  • Vba excel номер строки в диапазоне
  • Vba excel номер строки активной ячейки
  • Vba excel номер страницы