通过ProcKind值进行迭代时遇到问题

时间:2018-10-02 02:25:59

标签: excel vba excel-vba

我是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停止(无法响应)。最后,在Excel中Pk的值到底是多少,都显示为0。可能是什么?这完全是出于学术目的。 sample result

1 个答案:

答案 0 :(得分:2)

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