將行號添加到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，但它是一個驚人的難以找到一份副本。但這是一個很好的投資 - 還有很多其他有用的功能（例如自動添加錯誤處理程序）。