You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

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,避免嵌套循环的冗余:

  1. 先用ProcStartLine拿到过程的逻辑起始行,同时用ProcCountLines直接获取过程总行数(不用自己找End Sub)
  2. 从逻辑起始行开始向下遍历,找到第一个包含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

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.15 19:59:49