Question

如果它们的名称包含某些内容，我想获取工作簿中所有子名称来执行。但是我找不到合适的班级来做这种事情。你知道我该怎么做：

Dim mdl As Module
Dim macro As macro

For Each mdl In ThisWorkbook
    For Each macro In mdl
        If Left(macro.Name, 11) = "FilterChart" Then
            Run macro
            .Chart.Export ....
        End If
Next mdl

这就是我想做的事情的精神，但是我不知道该在循环中放入什么。有谁知道我想要达到的目标是否可能？预先谢谢你！

Answer 1

这段代码正是这样做的。

Sub GetProcedures()
  ' Declare variables to access the Excel workbook.
  Dim app As Excel.Application
  Dim wb As Excel.Workbook
  Dim wsOutput As Excel.Worksheet
  Dim sOutput() As String
  Dim sFileName As String

  ' Declare variables to access the macros in the workbook.
  Dim vbProj As VBIDE.VBProject
  Dim vbComp As VBIDE.VBComponent
  Dim vbMod As VBIDE.CodeModule

  ' Declare other miscellaneous variables.
  Dim iRow As Long
  Dim iCol As Long
  Dim iLine As Integer
  Dim sProcName As String
  Dim pk As vbext_ProcKind

  Set app = Excel.Application

  ' create new workbook for output
  Set wsOutput = app.Workbooks.Add.Worksheets(1)

  'For Each wb In app.Workbooks
  For Each vbProj In app.VBE.VBProjects

    ' Get the project details in the workbook.
    On Error Resume Next
    sFileName = vbProj.fileName
    If Err.Number <> 0 Then sFileName = "file not saved"
    On Error GoTo 0

    ' initialize output array
    ReDim sOutput(1 To 2)
    sOutput(1) = sFileName
    sOutput(2) = vbProj.Name
    iRow = 0

    ' check for protected project
    On Error Resume Next
    Set vbComp = vbProj.VBComponents(1)
    On Error GoTo 0

    If Not vbComp Is Nothing Then
      ' Iterate through each component in the project.
      For Each vbComp In vbProj.VBComponents

        ' Find the code module for the project.
        Set vbMod = vbComp.CodeModule

        ' Scan through the code module, looking for procedures.
        iLine = 1
        Do While iLine < vbMod.CountOfLines
          sProcName = vbMod.ProcOfLine(iLine, pk)
          If sProcName <> "" Then
            iRow = iRow + 1
            ReDim Preserve sOutput(1 To 2 + iRow)
            sOutput(2 + iRow) = vbComp.Name & ": " & sProcName
            iLine = iLine + vbMod.ProcCountLines(sProcName, pk)
          Else
            ' This line has no procedure, so go to the next line.
            iLine = iLine + 1
          End If
        Loop

        ' clean up
        Set vbMod = Nothing
        Set vbComp = Nothing

      Next
    Else
      ReDim Preserve sOutput(1 To 3)
      sOutput(3) = "Project protected"
    End If

    If UBound(sOutput) = 2 Then
      ReDim Preserve sOutput(1 To 3)
      sOutput(3) = "No code in project"
    End If

    ' define output location and dump output
    If Len(wsOutput.Range("A1").Value) = 0 Then
      iCol = 1
    Else
      iCol = wsOutput.Cells(1, wsOutput.Columns.Count).End(xlToLeft).Column + 1
    End If
    wsOutput.Cells(1, iCol).Resize(UBound(sOutput) + 1 - LBound(sOutput)).Value = _
        WorksheetFunction.Transpose(sOutput)

    ' clean up
    Set vbProj = Nothing
  Next

  ' clean up
  wsOutput.UsedRange.Columns.AutoFit
End Sub

几个月前，我在某个网站上找到了它。

Answer 2

为了能够以编程方式读取工作表中的Visual Basic代码的详细信息，您需要将工作簿设置为允许访问vb代码。文件，选项，高级，信任中心，信任中心设置，宏设置，然后选中“信任对VBA项目模型的访问”

然后在vb编辑器中，您需要设置对“ Microsoft Visual Basic for Applications Extensibility”的引用（版本号会因您的安装而有所不同）

然后您可以运行此命令以将名称转储到立即窗口（可以进行修改以适合）

Sub getnames()

Dim p As VBProject
Dim m As VBComponent
Dim l As Long
Dim s As String
Set p = ThisWorkbook.VBProject
For Each m In p.VBComponents
With m.CodeModule
    If .CountOfLines > 2 Then
    For l = 2 To .CountOfLines
    s = .Lines(l, 1)
    If Left(s, 4) = "Sub " Then
        Debug.Print Replace(s, "Sub ", "")
    End If

    Next l
 End If
End With
Next m
End Sub

获取工作簿中所有Sub的名称

2 个答案: