将行号添加到VBA代码（Microsoft Access 2016）

Question

我希望能够将行号添加到我的VBA代码中，以便我可以使用erl函数进行错误检查。 www.fmsinc.com上提供了一个工具包，可以做到这一点，但理想情况下，我希望能够自己编写代码，以便在需要时也可以删除编号。

有没有一种方法可以从应用程序中读取/修改VBA代码（它是一个.accdb文件）？假设有，我应该能够为包含代码的特定行添加一个数字。

Answer 1

这适用于我...将其添加到自己的模块。调用代码会打开或关闭行号。在引号中添加模块标题和/或过程标题将只更新命名的模块或过程。

Option Compare Database 
    Option Explicit 

    Sub AddLineNumbers(Optional vbCompName As String, Optional vbCompSubName As String) 
    On Error Resume Next 

     DoCmd.Hourglass True 
     Application.VBE.ActiveVBProject.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 5, 0 
     Call ExecuteAddLineNumbers(vbCompName, vbCompSubName) 
     DoCmd.Hourglass False 

    End Sub 

    Sub ExecuteAddLineNumbers(Optional vbCompName As String, Optional vbCompSubName As String) 
    On Error GoTo Err_Handler 

     'create a reference to the Microsoft Visual Basic for Applications Extensibility library 
     Dim i As Long, j As Long, lineN As Long 
     Dim procName As String 
     Dim startOfProceedure As Long 
     Dim lengthOfProceedure As Long 
     Dim newLine As String 
     Dim objComponent As Object 
     Dim lineNumber As Long 
     Dim HasLineNumbers As Boolean 

     For Each objComponent In Application.VBE.ActiveVBProject.VBComponents 
      If (vbCompName = vbNullString Or objComponent.Name = vbCompName) And objComponent.Name <> _ 
      Application.VBE.ActiveCodePane.CodeModule.Name) Then 
       Debug.Print objComponent.Name 
       With objComponent.CodeModule 
        .CodePane.Window.Visible = False 
        For i = 1 To .CountOfLines 
         'Debug.Print .ProcOfLine(i, vbext_pk_Proc) 
         If procName = "" And .ProcOfLine(i, vbext_pk_Proc) <> "" Then 
          procName = .ProcOfLine(i, vbext_pk_Proc) 
          'vbext_pk_Get Specifies a procedure that returns the value of a property. 
          'vbext_pk_Let Specifies a procedure that assigns a value to a property. 
          'vbext_pk_Set Specifies a procedure that sets a reference to an object. 
          'vbext_pk_Proc Specifies all procedures other than property procedures. 
          'type=vbext_ct_ClassModule 
          'type=vbext_ct_StdModule 
          'type=vbext_ct_Document 
          If objComponent.Type = vbext_ct_ClassModule Then 
           If InStr(.Lines(i + 1, 1), " Let ") > 0 Then 
            startOfProceedure = .ProcStartLine(procName, vbext_pk_Let) 
            lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Let) 
           ElseIf InStr(.Lines(i + 1, 1), " Get ") > 0 Then 
            startOfProceedure = .ProcStartLine(procName, vbext_pk_Get) 
            lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Get) 
           ElseIf InStr(.Lines(i + 1, 1), " Set ") > 0 Then 
            startOfProceedure = .ProcStartLine(procName, vbext_pk_Set) 
            lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Set) 
           Else 
            startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc) 
            lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Proc) 
           End If 
          Else 
           startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc) 
           lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Proc) 
          End If 
          lineNumber = 10 
          HasLineNumbers = .Find("## ", startOfProceedure + 1, 1, startOfProceedure + lengthOfProceedure - 1, 1, _ 
          False, False, True) 
         End If 

         If (vbCompSubName = vbNullString And procName <> vbNullString) Or _ 
          (vbCompSubName <> vbNullString And procName = vbCompSubName) Then 

          If startOfProceedure + 1 < i And i < startOfProceedure + lengthOfProceedure - 1 Then 
           newLine = RemoveOneLineNumber(.Lines(i, 1), HasLineNumbers) 
           If Trim(newLine) <> vbNullString Then 
            If Not HasLabel(newLine) And Not (.Lines(i - 1, 1) Like "* _") Then 
             If HasLineNumbers = False Then newLine = CStr(lineNumber) & vbTab & newLine 
             .ReplaceLine i, newLine 
             lineNumber = lineNumber + 10 
            ElseIf Not HasLineNumbers Then 
             .ReplaceLine i, vbTab & newLine 
            Else 
             .ReplaceLine i, newLine 
            End If 
           End If 
          ElseIf i = startOfProceedure + lengthOfProceedure - 1 Then 
           procName = "" 
          End If 
         Else 
          procName = "" 
         End If 

        Next i 
        .CodePane.Window.Visible = True 
       End With 
      End If 
     Next objComponent 

    Exit Sub 

    Err_Handler: 
     MsgBox (Err.Number & ": " & Err.Description) 

    End Sub 

    Function RemoveOneLineNumber(aString As String, HasLineNumbers As Boolean) 
     Dim i As Double 
     RemoveOneLineNumber = aString 
     i = ((Len(Trim(Str(Val(aString))))/4) - Int(Len(Trim(Str(Val(aString))))/4)) * 4 
     If aString Like "#*" Then 
      RemoveOneLineNumber = Space(i) & Mid(aString, InStr(1, aString, " ", vbTextCompare)) 
      RemoveOneLineNumber = Right(aString, Len(aString) - 4) 
     ElseIf HasLineNumbers And aString Like " *" Then 
      RemoveOneLineNumber = Right(aString, Len(aString) - 4) 
     End If 
    End Function 

    Function HasLabel(ByVal aString As String) As Boolean 
     HasLabel = False 
     If Right(Trim(aString), 1) = ":" Or _ 
      Left(Trim(aString), 3) = "Dim" Or _ 
      Left(Trim(aString), 3) = "ReDim" Or _ 
      Left(Trim(aString), 1) = "'" Or _ 
      Left(Trim(aString), 6) = "Option" Or _ 
      Left(Trim(aString), 5) = "Debug" Or _ 
      Left(Trim(aString), 3) = "Sub" Or _ 
      Left(Trim(aString), 11) = "Private Sub" Or _ 
      Left(Trim(aString), 10) = "Public Sub" Or _ 
      Left(Trim(aString), 8) = "Function" Or _ 
      Left(Trim(aString), 12) = "End Function" Or _ 
      Left(Trim(aString), 8) = "Property" Or _ 
      Left(Trim(aString), 12) = "End Property" Or _ 
      Left(Trim(aString), 7) = "End Sub" Then HasLabel = True 

    End Function 

Answer 2

我使用此代码将行号添加到我的Excel项目中。我在网上找到的一段时间回来，我不记得在那里我得到了它，所以要归功于谁最初写的：

Sub AddLineNumbers(wbName As String, vbCompName As String) 
    'See MakeUF 
    Dim i As Long, j As Long, lineN As Long 
    Dim procName As String 
    Dim startOfProceedure As Long 
    Dim lengthOfProceedure As Long 
    Dim newLine As String 

    With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule 
     .CodePane.Window.Visible = False 

     For i = 1 To .CountOfLines 
      procName = .ProcOfLine(i, vbext_pk_Proc) 

      If procName <> vbNullString Then 
       startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc) 
       lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Proc) 

       If startOfProceedure + 1 < i And i < startOfProceedure + lengthOfProceedure - 1 Then 
        newLine = RemoveOneLineNumber(.Lines(i, 1)) 
        If Not HasLabel(newLine) And Not (.Lines(i - 1, 1) Like "* _") Then 
         .ReplaceLine i, CStr(i) & ":" & newLine 
        End If 
       End If 
      End If 

     Next i 
     .CodePane.Window.Visible = True 
    End With 
End Sub 

Sub RemoveLineNumbers(wbName As String, vbCompName As String) 
    'See MakeUF 
    Dim i As Long 
    With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule 
     For i = 1 To .CountOfLines 
      .ReplaceLine i, RemoveOneLineNumber(.Lines(i, 1)) 
     Next i 
    End With 
End Sub 

Function RemoveOneLineNumber(aString) 
    RemoveOneLineNumber = aString 
    If aString Like "#:*" Or aString Like "##:*" Or aString Like "###:*" Then 
     RemoveOneLineNumber = Mid(aString, 1 + InStr(1, aString, ":", vbTextCompare)) 
    End If 
End Function 

Function HasLabel(ByVal aString As String) As Boolean 
    HasLabel = InStr(1, aString & ":", ":") < InStr(1, aString & " ", " ") 
End Function 

你必须修改它以满足您的需求，因为你的工作在Access中，但我相信它的主要内容仍然适用。在Excel中，有一个用户窗体用于启动您指定模块的代码，但您应该只需传入模块名称（vbCompName）即可指定模块。我对Access VBA并不熟悉，所以我不确定你会在代码中替换Workbooks(wbName)。

Answer 3

MZ-Tools for VBA具有添加和删除行号到单个功能，模块或整个项目的功能。

见http://www.mztools.com/v8/onlinehelp/index.html?add_remove_line_numbers.htm

注1：我觉得最好的行号增量配置为1，而不是10。你永远不会手动添加行号插图中 - 当你编辑代码，你首先删除行号，然后在完成后将它们添加回来。注意2：直到几年前，MZ-Tools的免费版本3.0，但它是一个惊人的难以找到一份副本。但这是一个很好的投资 - 还有很多其他有用的功能（例如自动添加错误处理程序）。