我是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。可能是什么?这完全是出于学术目的。
答案 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