Excel VBA - 如何在代码编辑器中打开行号

Question

请善意帮助：如何在Excel VBA代码编辑器中打开行号？我正在使用Excel 2013版本。

谢谢。

Answer 1

这里是我的代码，在VBE IDE中添加行号。这是由Excel MVP mikerickson提供的解决方案here的改进。我一直在努力，因为在极少数情况下，我已经遇到过，VBE无法进入调试模式，例如，在代码中有一个.ReplaceLine方法。事实上，一旦执行它就无法进入调试模式，所以Erl可能对调试（而不是Debug.Print）有用。我已经添加了几个特征，例如：

• 可能性以添加行号作为标记：10: Dim foo as bar或作为单一号码由制表从代码分隔：10 Dim foo as bar
• 可能性行号增加的程序结束语句，并在numberered时将过程声明行的缩进与其End语句行相匹配。或不。
• 可能性附加行号，以空行的或不
• [WIP]可能性行号添加到特定的程序的模块中
• [WIP]匹配行号相匹配的缩进的代码行中的所有凹陷最后一行缩进。如果最后一行是200: End Sub，线30: With ActiveSheet将被重新缩进作为30: ActiveSheet
• [WIP]一个VBE IDE命令的增加直接使与当前模块的/ proc呼叫作为一个参数

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 /函数声明声明
• 不允许一个进程
• 一行不允许下列续行符之外之前不允许“_”（下划线）
• 不允许有更多的比每个代码行一个标签/行号~~>必须测试除行号以外的现有标签，否则会发生编译错误，试图强制行号。
• 不允许使用已具有特殊VBA含义的字符~~>允许的字符是[aZ]，[0-9]，é，è，ô，ù，£，£，甚至是“：” ！
• 编译器会在标签前修剪任何空格~~>所以如果有标签，行的第一个字符就是标签的第一个字符，它不能是空格。
• 用冒号附加行号将导致在“：”和第一个下一个字符之间插入空格（如果没有空格）
• 当用制表符/空格附加行号时，必须至少有最后一个数字与第一个下一个字符之间有一个空格，编译器不会像添加冒号分隔符那样添加它。
• 。ReplaceLine方法将覆盖编译规则，而不会显示任何编译错误，因为它在选择新行时或手动重新启动编译时会在设计模式下执行编译错误编译器'比VBA环境/系统更快'：例如，刚好在带冒号且没有任何空格的行号已用.ReplaceLine插入，如果调用.Lines属性以获取新字符串，则该字符串中已经附加了空格（冒号字符和字符串的第一个字符之间的空格）！
• 在调用.ReplaceLine（从它正在编辑的模块内部或外部）之后不能进入调试模式，直到代码运行并执行重置为止。