VBA中ProcStartLine返回空行行号,如何无需临时方案获取正确起始行?
问题描述
我写了一段VBA代码,用来给子程序/函数自动插入On Error GoTo ErrorHandler语句、ErrorHandler标签及对应处理代码(当这些内容不存在时)。但发现当子程序声明行前有空行时,ProcStartLine会返回空行的行号,而非实际的过程声明行。
带前置空行的子程序示例
Below empty line Sub SubWithBothNotAvail() d = k End Sub
我已经加了临时 workaround(从注释'*** Workaround starts ***开始)来修复这个问题,完整代码如下:
Sub AddErrorHandlers(ModuleName) Dim i As Long, j As Long, lineN As Long Dim procName As String Dim startOfProceedure As Long Dim lengthOfProceedure As Long Dim CodeModuleObj As CodeModule Dim ReplaceJump, LineValue, PrevLineValue, LenLine, YesNo Dim OnErrorGoToFound As Boolean, OnErrorGoToLabelFound As Boolean, AvailableLableNamesDic As New Scripting.Dictionary Dim ActualStartOfProcedureFound As Boolean 'ModuleName = "YourModuleName" 'Paste module name where lines' numbers should be added On Error Resume Next Set CodeModuleObj = ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule If CodeModuleObj Is Nothing Then MsgBox "Module Name " & ModuleName & " not exist" Exit Sub End If With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule i = 0 Do While i <= .CountOfLines i = i + 1 procName = .ProcOfLine(i, vbext_pk_Proc) If procName <> vbNullString Then startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc) If i = startOfProceedure Then 'It is because .ProcStartLine takes line number of a blank line. In this finding the blank line was above ProcLine '*** Workaround starts *** If InStr(1, .Lines(startOfProceedure, 1), procName & "(", vbTextCompare) = 0 Then ActualStartOfProcedureFound = False: lengthOfProceedure = 0 For j = startOfProceedure To .CountOfLines If InStr(1, .Lines(j, 1), procName & "(", vbTextCompare) Then startOfProceedure = j ActualStartOfProcedureFound = True For k = startOfProceedure + 1 To .CountOfLines If Left(.Lines(k, 1), 4) = "End " Then lengthOfProceedure = k - startOfProceedure + 1 Exit For End If Next k End If Next j End If If Not lengthOfProceedure Then Exit Sub End If '*** Workaround Ends *** AvailableLableNamesDic.RemoveAll OnErrorGoToFound = False: OnErrorGoToLabelFound = False For j = 1 To lengthOfProceedure - 1 lineN = startOfProceedure + j LineValue = .Lines(lineN, 1) PrevLineValue = .Lines(lineN - 1, 1) If Left(Trim(LineValue), 13) = "On Error GoTo" Then OnErrorGoToFound = True ErrorHandlerLabelName = Replace(Split(Trim(LineValue), " ")(3), ":", "") End If If Right(LineValue, 1) = ":" Then If InStr(1, LineValue, " ", vbTextCompare) = 0 Then AvailableLableNamesDic(Left(LineValue, Len(LineValue) - 1)) = j End If End If If OnErrorGoToLabelFound Then Exit For ElseIf OnErrorGoToFound Then If LineValue = ErrorHandlerLabelName & ":" Then OnErrorGoToLabelFound = True End If End If Next j If OnErrorGoToLabelFound Then 'Both found. so can be skipped Debug.Print procName & ":" & startOfProceedure & ":" & lengthOfProceedure & " Both found" & "," & .ProcOfLine(i, vbext_pk_Proc) ElseIf OnErrorGoToFound Then 'Need to insert the ErrorHandler k = startOfProceedure + lengthOfProceedure - 1 .InsertLines k, ErrorHandlerLabelName & ":" Debug.Print procName & ":" & startOfProceedure & ":" & lengthOfProceedure & " Need to insert the errorhandler. k value: " & k & "," & .ProcOfLine(k, vbext_pk_Proc) .InsertLines k + 1, "If Err.Number <> 0 Then" Debug.Print procName & ":" & startOfProceedure & ":" & lengthOfProceedure & " Need to insert the errorhandler. k value: " & k + 1 & "," & .ProcOfLine(k + 1, vbext_pk_Proc) .InsertLines k + 2, " PrintErrorLog ""Error Line: "" & Erl & "", Error Desc: "" & Err.Description & "", " & ModuleName & "." & procName Debug.Print procName & ":" & startOfProceedure & ":" & lengthOfProceedure & " Need to insert the errorhandler. k value: " & k + 2 & "," & .ProcOfLine(k + 2, vbext_pk_Proc) .InsertLines k + 3, "End If" Debug.Print procName & ":" & startOfProceedure & ":" & lengthOfProceedure & " Need to insert the errorhandler. k value: " & k + 3 & "," & .ProcOfLine(k + 3, vbext_pk_Proc) ElseIf OnErrorGoToFound = False And OnErrorGoToLabelFound Then 'ErrorHandler label is there. Need to insert only 'On Error Go To ErrorHandler' .InsertLines startOfProceedure + 1, "On Error GoTo " & ErrorHandlerLabelName & ": d = " & """"" & "Only on error" & """"" Debug.Print procName & ":" & startOfProceedure & ":" & lengthOfProceedure & " Need to insert only 'On Error Go To ErrorHandler'. startOfProceedure + 1: " & (startOfProceedure + 1) & "," & .ProcOfLine((startOfProceedure + 1), vbext_pk_Proc) Else 'Both should be inserted .InsertLines startOfProceedure + 1, "On Error GoTo ErrorHandler: d = " & """"" & "Both" & """"" Debug.Print procName & ":" & startOfProceedure & ":" & lengthOfProceedure & " Both should be inserted'. startOfProceedure + 1: " & (startOfProceedure + 1) & "," & .ProcOfLine((startOfProceedure + 1), vbext_pk_Proc) k = startOfProceedure + lengthOfProceedure - 1 .InsertLines k, ErrorHandlerLabelName & ":" .InsertLines k + 1, "If Err.Number <> 0 Then" .InsertLines k + 2, " PrintErrorLog ""Error Line: "" & Erl & "", Error Desc: "" & Err.Description & "", " & ModuleName & "." & procName .InsertLines k + 3, "End If" End If End If End If Loop End With End Sub
现咨询:有没有办法直接通过ProcStartLine获取正确的过程起始行,无需使用该临时workaround?
回答
没有办法直接通过ProcStartLine获取到过程的实际声明行——这是VBA的CodeModule对象的固有行为:ProcStartLine返回的是过程的逻辑起始行,包含声明行之前的空行、注释行甚至是模块级的空白分隔行,而非严格的Sub/Function/Property声明语句所在的行。
不过可以用更简洁高效的方式替代原workaround,避免嵌套循环的冗余:
- 先用
ProcStartLine拿到过程的逻辑起始行,同时用ProcCountLines直接获取过程总行数(不用自己找End Sub) - 从逻辑起始行开始向下遍历,找到第一个包含
procName & "("的非空行,这就是实际的声明行
示例代码片段:
procName = .ProcOfLine(i, vbext_pk_Proc) startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc) lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Proc) ' 定位实际的过程声明行 Do While startOfProceedure <= .CountOfLines Dim lineText As String lineText = Trim(.Lines(startOfProceedure, 1)) If InStr(1, lineText, procName & "(", vbTextCompare) > 0 Then Exit Do End If startOfProceedure = startOfProceedure + 1 Loop
这个方法不仅代码更简洁,还能避免自己计算过程长度时可能出现的错误(比如过程内部嵌套End语句的情况)。
内容的提问来源于stack exchange,提问作者Dhay
相关产品推荐
相关产品推荐

