Excel VBA-如何在代码编辑器中打开行号 [英] Excel VBA - How to Turn On Line Numbers in Code Editor

问题描述

请帮助:如何在Excel VBA代码编辑器中打开行号?我正在使用Excel 2013版本.

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

谢谢.

推荐答案

这是我的代码，用于在VBE IDE中添加行号.它提供了此处，由Excel MVP mikerickson提供.我已经做了这个工作，因为在极少数情况下，我已经遇到过，例如当代码中有.ReplaceLine方法时，VBE无法进入调试模式.确实，一旦执行后就无法进入调试模式，因此Erl可能对调试很有用(而不是Debug.Print).我添加了一些功能，例如:

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:

• 可以将行号添加为标签:10: Dim foo as bar，也可以将单个数字与制表符从代码中分隔出来:10 Dim foo as bar
• 可以在行末语句中添加行号，并在编号后将过程声明行的缩进与其末行语句相匹配.是否.
• 是否可以将行号添加到空行
• [WIP]可以向模块中的特定过程添加行号
• [WIP]将代码行的所有缩进与行号匹配，以匹配最后缩进的行的缩进.如果最后一行是200: End Sub，则行30: With ActiveSheet将重新缩进为30: ActiveSheet
• [WIP]添加了VBE IDE命令，以使用当前模块/proc作为参数直接进行调用

• 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:

• 在Sub/Function声明语句之前不允许
• 不允许在proc之外
• 不允许在行连续字符"_"(下划线)之后的行
• 每条代码行不允许有多个标签/行号~~>必须测试行号以外的现有标签，否则尝试强制行号会发生编译错误.
• 不允许使用已经具有特殊VBA含义的字符~~>允许使用的字符包括[aZ]，[0-9]，é，è，ô，ù，€，£，§甚至是:" ！
• 编译器会在标签之前修剪所有空格~~>因此，如果有标签，则该行的第一个字符为标签的第一个字符，不能为空格.
• 在行号后加上冒号将导致在:"和第一个下一个字符之间插入空格(如果没有)
• 当在行号后加上制表符/空格时，最后一位和下一个第一个字符之间必须至少有一个空格，编译器不会像使用冒号分隔符的标签那样添加空格
• .ReplaceLine方法将覆盖编译规则，而不显示选择新行或手动重新启动编译时在设计模式下所做的任何编译错误
• 编译器比VBA环境/系统快":例如，在使用.ReplaceLine插入带有冒号且没有任何空格的行号之后，如果调用了.Lines属性以获取新字符串，空格(冒号和字符串的第一个字符之间)已经附加在该字符串中！
• (在正在编辑的模块内部或外部)调用.ReplaceLine之后，直到代码运行并重置执行后，才能进入调试模式.

• 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.

这篇关于Excel VBA-如何在代码编辑器中打开行号的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！