VBA 列出 powerpoint 演示文稿的所有对象名称

Question

我正在寻找一种方法，通过简单的 VBA 脚本自动列出 PowerPoint 演示文稿中的所有对象名称。我在几张幻灯片上使用选择窗格命名某些对象，并且需要在每张幻灯片上生成所有对象名称的列表。不幸的是，我的知识几乎为零，但我设法改编了我在此处找到的脚本

Sub ListAllShapes()

Dim curSlide As Slide
Dim curShape As Shape

For Each curSlide In ActivePresentation.Slides
    Debug.Print curSlide.SlideNumber
    For Each curShape In curSlide.Shapes


                Debug.Print curShape.Name


    Next curShape
Next curSlide
End Sub

脚本的问题在于它达到了 190 行左右的调试屏幕缓冲区的限制并剪切了形状列表的第一部分。如果可以将调试输出写入外部 txt 文件，那就太好了。

另一种绕过调试行限制的解决方案是放置形状名称的过滤器，以便它只打印具有特定前缀的名称。例如名称以 "ph-"

开头的所有形状

也欢迎其他解决方案。谢谢

Answer 1

我曾经写过一些代码，旨在做到这一点 - 尝试一下，希望对您有所帮助！

Sub ReadPPT()
Dim WB As Workbook
Dim PP As PowerPoint.Application
Dim Pres As PowerPoint.Presentation
Dim SLD As PowerPoint.Slide
Dim SHP As PowerPoint.Shape
Dim PresPath As String
Dim r As Long
Dim sh As Long

Set WB = ThisWorkbook
With ThisWorkbook.Sheets(1)

'Let user select a ppt-file and select its path
PresPath = Application.GetOpenFilename("PowerPoint Presentations (*.pptx), *.pptx", _
            , "Open Presentation", "Open", 0)

If PresPath = "" Then Exit Sub

'Create ppt-Application and show it
Set PP = CreateObject("PowerPoint.Application")
PP.Visible = True

'Open previously selected ppt-file
Set Pres = PP.Presentations.Open(PresPath)

sh = 1
For Each SLD In Pres.Slides
    r = 2
    If SLD.Shapes.Count > 9 Then
'        .Cells(0 + r, 2) = SLD.SlideID
'        r = r + 1
        For Each SHP In SLD.Shapes
            If SHP.HasTextFrame Then
                If SHP.TextFrame.HasText Then
                    .Cells(0 + r, 2) = CStr(SHP.Name)
                    .Cells(0 + r, 3) = CStr(SHP.TextFrame.TextRange.Text)
                    r = r + 1
                End If
            End If
        Next SHP
    sh = sh + 1
    End If
Next SLD

PP.Quit

End With
End Sub

Answer 2

使用您的代码并按照@SteveRindsberg 的建议-输出到文本文件。
此代码将在与您的演示文稿相同的文件夹中创建文件：

Sub ListAllShapes()

    Dim curSlide As Slide
    Dim curShape As Shape
    Dim lFile As Long
    Dim sPath As String

    sPath = ActivePresentation.Path

    lFile = FreeFile

    Open sPath & "\Object Names.txt" For Append As #lFile

    For Each curSlide In ActivePresentation.Slides
        Print #lFile, curSlide.SlideNumber
        For Each curShape In curSlide.Shapes
            If Left(curShape.Name, 3) = "ph-" Then
                Print #lFile, curShape.Name
            End If
        Next curShape
    Next curSlide

    Close #lFile

End Sub

VBA 列出 powerpoint 演示文稿的所有对象名称

VBA to list all object names of a powerpoint presentation

powerpoint

vba