有没有办法用行号快速标记VBA代码，如下所示？
Sub sample()
Dim i As Long
10 Debug.Print "A"
20 Debug.Print "B"
30 Debug.Print "C"
40 Debug.Print "D"
50 MsgBox "Done."
End Sub
答案 0 :(得分：1)
正如您在此回答Log what line error occurs: vba中所看到的，有两种方法可以做到：
VBA Extensibility编写自己的加载项来执行此操作。 修改：我从未与VBE extensivbility图书馆合作过，因此我建议您咨询其他来源，例如：http://www.cpearson.com/excel/vbe.aspx
重新利用Chip Pearson编写的代码我会尝试以下方法，尽管我还没有测试过它：
With VBComp.CodeModule 'VBComp is VBIDE.VBComponent
For N = 1 To .CountOfLines
If Trim(.Lines(N, 1)) = vbNullString Then
' blank line, skip it
ElseIf Left(Trim(.Lines(N, 1)), 1) = "'" Then
' comment line, skip it
Else
.Lines(N, 1) = N & " " & .Lines(N,1)
End If
Next N
End With
请注意，您需要确保检查各种情况，例如已经编号的行。
答案 1 :(得分：0)
如果您想为工作簿中的所有模块提供（更新的）行号（添加和删除），您可以应用以下步骤* ^°°。请考虑此警告。
做一次：
Module2中的大代码粘贴到工作簿中。Module3的代码粘贴到工作簿中。Module4的代码粘贴到工作簿中。Global allow_for_line_addition As String行，这样您就可以自动添加每个第一行上方/的内容
模块。end sub，end function或End Property之后不会输入任何内容。每次修改代码时都会这样做：
Module3的代码，删除工作簿中所有模块的行号。Module4的代码，为工作簿中的所有模块添加行号。 <强> 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
<强> 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://stackoverflow.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
<强> 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 httpsstackoverflow.comquestions40731182excel-vba-how-to-turn-on-line-numbers-in-code-editor50368332#50368332
Sub add_line_numbering_all_modules()
'source: https://www.stackoverflow.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（注意不是“”），反之亦然。