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

使用您的代码和@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

Answer 2

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

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

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

2 个答案: