添加调试输出函数名的插件代码

boy8199

方便 在程序运行中 在 立即窗口 看到  调用函数的 顺序.

可以做成插件,或者独立模块(需要搞一下,模块名判断)
需要引用 vb 扩展库(系统自带)  vb for applications extensiblility

vb6 addin 插件工程, 复制代码, 需要略微修改一下. 即可.
vba 的话 要改一下 VBInstance.ActiveVBProject.VBComponents  的引用.
ActiveWorkbook.VBProject.VBComponents



'==================='

1. Function ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
   
2.       Debug.Print "--> frmAddIn : ProcKindString"                 '统一输出函数名
   
3. 
   
4.     Select Case ProcKind
   
5.         Case vbext_pk_Get
   
6.             ProcKindString = "Property Get"
   
7.         Case vbext_pk_Let
   
8.             ProcKindString = "Property Let"
   
9.         Case vbext_pk_Set
   
10.             ProcKindString = "Property Set"
    
11.         Case vbext_pk_Proc
    
12.             ProcKindString = "Sub Or Function"
    
13.         Case Else
    
14.             ProcKindString = "Unknown Type: " & CStr(ProcKind)
    
15.     End Select
    
16. End Function
    
17. 
    
18. Private Sub cmdCommand1_Click()
    
19.       Debug.Print "--> frmAddIn : cmdCommand1_Click"                 '统一输出函数名
    
20.     Dim i As Long: Dim j As Long: Dim k As Long
    
21.     Dim VBCs As VBComponents
    
22.     Dim cm As CodeModule
    
23.     Dim ProcName As String
    
24.     Dim ProcKind As VBIDE.vbext_ProcKind
    
25.     Dim pbl As Long: Dim tempStr As String: Dim pbl1 As Long     'pbl1 函数身体+1行
    
26.   
    
27.     txtText1.Text = ""
    
28.   
    
29.     Set VBCs = VBInstance.ActiveVBProject.VBComponents
    
30.    
    
31.    
    
32.     For i = 1 To VBCs.Count
    
33.       
    
34.       Set cm = VBCs(i).CodeModule
    
35.       txtText1.Text = txtText1.Text & VBCs(i).Type & ":" & VBCs(i).Name & "--------" & vbCrLf
    
36.    
    
37.      j = 0
    
38.       With cm
    
39.           j = .CountOfDeclarationLines + 1
    
40.           Do Until j >= .CountOfLines
    
41.               ProcName = .ProcOfLine(j, ProcKind)
    
42.               
    
43.               pbl = .ProcBodyLine(ProcName, ProcKind)
    
44.               txtText1 = txtText1 & ProcName & " | " & ProcKindString(ProcKind) & " | " _
    
45.                         & pbl & vbCrLf
    
46.                                  
    
47.               j = .ProcStartLine(ProcName, ProcKind) + .ProcCountLines(ProcName, ProcKind)
    
48.             
    
49.                 For k = pbl To j
    
50.                    tempStr = .Lines(k, 1)
    
51.                    If Right(tempStr, 1) <> "_" Then
    
52.                         pbl1 = k + 1
    
53.                         Exit For
    
54.                    End If
    
55.                 Next
    
56.                
    
57.                 For k = pbl1 To j
    
58.                     tempStr = Trim(.Lines(k, 1))
    
59.                     
    
60.                     If Len(tempStr) > 0 Then
    
61.                         If (Left(tempStr, 11) = "Debug.Print") And (Right(tempStr, 8) = "'统一输出函数名") Then
    
62.                            
    
63.                             Call cm.DeleteLines(k, 1)
    
64.                             k = k - 1
    
65.                             j = j - 1
    
66.                         End If
    
67.                     End If
    
68. 
    
69.                 Next
    
70.                
    
71.                 Call cm.InsertLines(pbl1, "      " & "Debug.Print """ & "--> " _
    
72.                         & VBCs(i).Name & " : " & ProcName & """                 '统一输出函数名")
    
73.                               
    
74.             j = .ProcStartLine(ProcName, ProcKind) + .ProcCountLines(ProcName, ProcKind) + 1
    
75.           Loop
    
76.       End With
    
77.      txtText1.Text = txtText1.Text & vbCrLf
    
78.      
    
79.     Next
    
80. End Sub
    
81. 
    

复制代码

'==========='