☰

從 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 中的文件名。

相關內容