时间戳

首页 > 解决方案 > 遍历 ProcKind 值的问题

vba - 遍历 ProcKind 值的问题

问题描述

我是 VBA 的新手，但最近关注 @Marcucciboy2、@Cindy Meister 和 @Mathieu Guindon，感谢他们在 VBA 中的出色贡献。在分别导出 VBA 程序（子/函数）主题中，我在@Mathieu Guindon 的指导方针中尝试了一些，并遇到了一些新问题。

'Public Const vbext_pk_Get As Long = 3
'Public Const vbext_pk_Let As Long = 1
'Public Const vbext_pk_Set As Long = 2
'Public Const vbext_pk_Proc As Long = 0

'sub function
'sub function

Sub test3()
Rw = 15
Dim Vbc As VBComponent
Dim Lno, StLine, LineCnt, CmntPos, ParenthPos As Long
Dim Line, Pname1, Pname2, SubOrFun As String, Pk As vbext_ProcKind

Pk = vbext_pk_Proc

    For Each Vbc In ThisWorkbook.VBProject.VBComponents
        Lno = 1
        Pname1 = ""
            For Lno = 1 To Vbc.CodeModule.CountOfLines
            Line = Vbc.CodeModule.Lines(Lno, 1)
            'For Pk = 0 To 3                   **'Activating this For loop cuasing Excel to come to a halt (not responding)'**
            Pname2 = Vbc.CodeModule.ProcOfLine(Lno, Pk)

            'Filter the line only up to the 1st comment character or 1st parenthesis
            '(due to possibility of some parameter name may ends with "sub " or "function ")
            CmntPos = InStr(1, Line, "'")
            ParenthPos = InStr(1, Line, "(")
            If CmntPos > 0 Then Line = Trim(Left(Line, CmntPos - 1))
            If ParenthPos > 0 Then Line = Left(Line, ParenthPos - 1)


                If Line <> "" And Pname1 <> Pname2 Then
                Line = LCase(Replace(Line, Pname2, ""))   'In some cases function name can also contain "sub" like "Batch_subtraction" and vice verse some of the procedures name can be  "functionality_View"
                SubOrFun = IIf(InStr(1, Line, "function") > 0, "Function", "Sub")

                StLine = 0
                LineCnt = 0
                StLine = Vbc.CodeModule.ProcStartLine(Pname2, Pk)     'Startline including comment lines
                LineCnt = Vbc.CodeModule.ProcCountLines(Pname2, Pk)   'line Count including comment lines
                Pname1 = Pname2
' sub function

                Rw = Rw + 1
                ' following lines are only for trial/debugging purpose, the results being stored in excel cells
                ' in actual case here should be  the lines of the procedure can be processed by StLine and LineCnt
                ' Or added to a collection for further processing
                ThisWorkbook.Sheets(3).Cells(Rw, 1).Value = Vbc.Name
                ThisWorkbook.Sheets(3).Cells(Rw, 2).Value = Pname2
                ThisWorkbook.Sheets(3).Cells(Rw, 3).Value = SubOrFun
                ThisWorkbook.Sheets(3).Cells(Rw, 4).Value = StLine
                ThisWorkbook.Sheets(3).Cells(Rw, 5).Value = LineCnt
                ThisWorkbook.Sheets(3).Cells(Rw, 6).Value = Lno
                ThisWorkbook.Sheets(3).Cells(Rw, 7).Value = Line
                ThisWorkbook.Sheets(3).Cells(Rw, 8).Value = Pk
                End If
            'Next
            Next
    Next

End Sub
'sub function

它工作正常。现在，当我尝试遍历 Pk= 0 到 3 时，excel 将停止（无法响应）。此外，无论 Pk 的值最终在 Excel 中是什么，它都显示为 0。可能是什么问题？这纯粹是出于学术目的。 样本结果

标签： vbaexcel

解决方案

Pname2 = Vbc.CodeModule.ProcOfLine(Lno, Pk)

的用法ProcOfLine很尴尬，因为ProcKind参数不只是传递ByRef，因为ByRef它是 VBA 中的默认值：ProcKind传递参数是ByRef因为ProcKind枚举值是函数的输出！

Dim Pk As vbext_ProcKind
Pname2 = Vbc.CodeModule.ProcOfLine(Lno, Pk)
Debug.Print Pk ' <~ that's the ProcKind of procedure Pname2 which Lno belongs to

签名如下所示：

Property Get ProcOfLine(Line As Long, ProcKind As vbext_ProcKind) As String

如果是这样的话，它的用法可能会更清楚：

Property Get ProcOfLine(ByVal Line As Long, ByRef outProcKind As vbext_ProcKind) As String

推荐阅读