☰

从 Powerpoint 中提取文本

tag-icon • tag-icon vba microsoft-powerpoint extract
从 Powerpoint 中提取文本

因此，我在这里找到了这个不错的脚本： http://www.pptfaq.com/FAQ00274_Export_Text_to_a_text_file-_extract_text_from_PowerPoint_-Mac_or_PC-.htm （我用的是第二个）

导入部分是这样的：

 For Each oShp In oSld.Shapes                'Loop thru each shape on slide
      'Check to see if shape has a text frame and text
      If oShp.HasTextFrame And oShp.TextFrame.HasText Then
        If oShp.Type = msoPlaceholder Then
            Select Case oShp.PlaceholderFormat.Type
                Case Is = ppPlaceholderTitle, ppPlaceholderCenterTitle
                    Print #iFile, "Title:" & vbTab & oShp.TextFrame.TextRange
                Case Is = ppPlaceholderBody
                    Print #iFile, "Body:" & vbTab & oShp.TextFrame.TextRange
                Case Is = ppPlaceholderSubtitle
                    Print #iFile, "SubTitle:" & vbTab & oShp.TextFrame.TextRange
                Case Else
                    Print #iFile, "Other Placeholder:" & vbTab & oShp.TextFrame.TextRange
            End Select
        Else
            Print #iFile, vbTab & oShp.TextFrame.TextRange
        End If  ' msoPlaceholder
      Else  ' it doesn't have a textframe - it might be a group that contains text so:
        If oShp.Type = msoGroup Then
            sTempString = TextFromGroupShape(oShp)
            If Len(sTempString) > 0 Then
                Print #iFile, sTempString
            End If
        End If
      End If    ' Has text frame/Has text

    Next oShp

我已经对其进行了一些修改，因此输出文件不包含“标题”、“其他占位符”等文本，也不插入制表符（“vbTab”）。但是，它将每一行（或段落）放入输出文件的新行中。

问题：我如何告诉脚本将“幻灯片”/“正文”中的所有“内容”转储到同一行/单元格中？

我注意到这个脚本（以及这个http://www.pptfaq.com/FAQ00332_Export_Slide_Number_and_Title_Text_to_a_text_file.htm) 对标题表现出这种行为，仅适用于“body”或“ppPlaceholderBody”。

我不知道为什么会这样，也不知道有什么区别。难道它根本就无法区分两行或公告，即使是在相同的形状/框中？我的目标是在多个 .ppt 上使用一致的行/单元格编号，以便在幻灯片 2 中添加一行不会导致幻灯片 5 中的内容移到下一行。

感谢您的帮助！

答案1

我的 PowerPoint 安装目前已关闭，因此尚未测试。但是...

您只需创建一个字符串变量并添加到其中，然后在完成幻灯片后，将该字符串复制到 Excel 单元格。

Dim slideText As String
For Each oShp In oSld.Shapes                 'Loop thru each shape on slide
    If Len(slideText) > 0 Then
        '--- strip the unneeded trailing CRLF
        slideText = Left$(slideText, Len(slideText) - 2)
        '--- now copy the string to the appropriate cell in Excel
    Else
        '--- clear the string for the next slide
        slideText = vbNullString
    End If

    'Check to see if shape has a text frame and text
    If oShp.HasTextFrame Then
        If oShp.TextFrame.HasText Then
            If oShp.Type = msoPlaceholder Then
                Select Case oShp.PlaceholderFormat.Type
                    Case Is = ppPlaceholderTitle, ppPlaceholderCenterTitle
                        slideText = slideText & "Title:" & vbTab & _
                                    oShp.TextFrame.TextRange & vbCrLf
                    Case Is = ppPlaceholderBody
                        slideText = slideText & "Body:" & vbTab & _
                                    oShp.TextFrame.TextRange & vbCrLf
                    Case Is = ppPlaceholderSubtitle
                        slideText = slideText & "SubTitle:" & vbTab & _
                                    oShp.TextFrame.TextRange & vbCrLf
                    Case Else
                        slideText = slideText & "Other Placeholder:" & _
                                    vbTab & oShp.TextFrame.TextRange & vbCrLf
                End Select
            Else
                slideText = slideText & vbTab & oShp.TextFrame.TextRange
            End If                           ' msoPlaceholder
        End If
    Else
        ' it doesn't have a textframe - it might be a group that contains text so:
        If oShp.Type = msoGroup Then
            sTempString = TextFromGroupShape(oShp)
            If Len(sTempString) > 0 Then
                slideText = slideText & sTempString & vbCrLf
            End If
        End If
    End If                                   ' Has text frame/Has text
Next oShp

'--- catch the text on the last slide here
If Len(slideText) > 0 Then
    '--- strip the unneeded trailing CRLF
    slideText = Left$(slideText, Len(slideText) - 2)
    '--- now copy the string to the appropriate cell in Excel
End If

当然，你要对每张幻灯片都进​​行这样的循环。

答案2

我认为这没什么帮助，但是：https://stackoverflow.com/questions/45468824/printing-from-ppt-vba-to-an-excel-spreadsheet 尝试使用 Lbound 和 Ubound 进行类似的操作来打印到特定单元格。

只要单元格在多个 ppt/xls 上保持一致，我实际上就不知道字符串去了哪里......

（虽然它也选择了一个特定的 xls 文件，但我想为每次打印创建一个新的文件，但这对于我已有的代码来说应该不是问题，它可以创建一个指定的文件或使用 ppt 中的文件名。）

相关内容