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

如何在MS Project中列出所有子程序及其所属模块名

MS Project宏库子程序列表生成方案

问题背景

我在独立的MS Project文件中按模块分组存储了大量实用宏,将其作为宏库使用。为遵循最佳实践,我希望在其他子程序中复用已有子程序,但每次都要花费时间在模块中查找目标宏。我需要生成包含子程序及其所属模块的列表,以便快速定位并使用Call Module.Sub语句调用到当前代码中。此前未找到相关方法,不知从何入手。

解决方案代码

更新:参考相关资料后,我找到了适配自身需求的代码,现将该代码附上,供有需要的用户参考:

'---------------------------------------------------------------------------------------
' 功能     :       输出项目中所有子程序和函数
' 前置条件:    需引用Microsoft Visual Basic for Applications Extensibility 5.3库
' 运行方法:       运行X_GetFunctionAndSubNames,设置参数blnWithParentInfo
'                   当ComponentTypeToString(vbext_ct_StdModule)返回"代码模块"时执行
'---------------------------------------------------------------------------------------

'基于现有代码修改而来
'主要修改:适配MS Project而非Excel,增加模块名称显示选项,将CreateLogFile改为Debug.Print输出
'添加了列表显示方式的选择功能

Option Explicit

Private strSubsInfo As String
Public Sub X_GetFunctionAndSubNames()
 
    Dim item            As Variant
    strSubsInfo = ""
    Dim displaychoice As Integer
    
    displaychoice = InputBox("请选择模块名称的显示方式:" & vbCrLf & "1 = 与子程序名称同行,用':'分隔" & vbCrLf & "2 = 先显示模块名称,再列出该模块下的子程序")
    If Not (displaychoice = 1 Or displaychoice = 2) Then
        MsgBox ("只能选择1或2,程序将退出")
        Exit Sub
    End If
    
    For Each item In ThisProject.VBProject.VBComponents
        
        If ComponentTypeToString(vbext_ct_StdModule) = "代码模块" Then
            ListProcedures item.Name, displaychoice, False
        End If
        
    Next item
    Debug.Print strSubsInfo
    Clipboard (strSubsInfo)
    MsgBox ("子程序和模块名称已输出到立即窗口,并已复制到剪贴板")
End Sub

Private Sub ListProcedures(strName As String, displaychoice As Integer, Optional blnWithParentInfo = False)

    '运行此子程序需引用Microsoft Visual Basic for Applications Extensibility 5.3库

    Dim VBProj          As VBIDE.VBProject
    Dim VBComp          As VBIDE.VBComponent
    Dim CodeMod         As VBIDE.CodeModule
    Dim LineNum         As Long
    Dim ProcName        As String
    Dim ModuleName As String
    Dim ProcKind        As VBIDE.vbext_ProcKind
   

    Set VBProj = ThisProject.VBProject
    Set VBComp = VBProj.VBComponents(strName)
    Set CodeMod = VBComp.CodeModule
    ModuleName = VBComp.CodeModule.Name
    
    If displaychoice = 2 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & "模块 - " & ModuleName
    
    With CodeMod
        LineNum = .CountOfDeclarationLines + 1
        
        Do Until LineNum >= .CountOfLines
            ProcName = .ProcOfLine(LineNum, ProcKind)

            If blnWithParentInfo Then
                If displaychoice = 2 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & strName & "." & ProcName
                If displaychoice = 1 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & strName & "." & ProcName & " : " & ModuleName
            Else
                If displaychoice = 2 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & ProcName
                If displaychoice = 1 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & ProcName & " : " & ModuleName
            End If

            LineNum = .ProcStartLine(ProcName, ProcKind) + .ProcCountLines(ProcName, ProcKind) + 1
        Loop
    End With
End Sub

Function ComponentTypeToString(ComponentType As VBIDE.vbext_ComponentType) As String
    '将组件类型枚举转换为可读字符串
    Select Case ComponentType
    
        Case vbext_ct_ActiveXDesigner
            ComponentTypeToString = "ActiveX设计器"
            
        Case vbext_ct_ClassModule
            ComponentTypeToString = "类模块"
            
        Case vbext_ct_Document
            ComponentTypeToString = "文档模块"
            
        Case vbext_ct_MSForm
            ComponentTypeToString = "用户窗体"
            
        Case vbext_ct_StdModule
            ComponentTypeToString = "代码模块"
            
        Case Else
            ComponentTypeToString = "未知类型: " & CStr(ComponentType)
            
    End Select
    
End Function

Function Clipboard(Optional StoreText As String) As String
'功能: 读写剪贴板
'实现逻辑:通过HTMLFile对象操作剪贴板

Dim x As Variant

'存为Variant类型以支持64位VBA
  x = StoreText

'创建HTMLFile对象
  With CreateObject("htmlfile")
    With .parentWindow.clipboardData
      Select Case True
        Case Len(StoreText) > 0
          '写入剪贴板
            .setData "text", x
        Case Else
          '读取剪贴板(未传入参数时)
            Clipboard = .GetData("text")
      End Select
    End With
  End With

End Function

内容的提问来源于stack exchange,提问作者Miles

相关产品推荐
方舟 Agent Plan

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

最近更新时间:2026.07.03 22:47:33