星期三, 12月 10, 2014

取得 PPT 投影片中的所有文字

PowerPoint中似乎沒有方便的工具可以取出投影片上所有的文字,搜尋之後, 找到了高手的 VBA 程式, 簡單修改加上存成文字檔的功能後, 就可以使用了。完整程式碼如下:

Sub 取出文字()
    Dim p As Presentation: Set p = ActivePresentation
    Dim s As Slide
    Dim sh As Shape
    
    FName = ActivePresentation.FullName 'Word檔名
    txtFname = Left(FName, Len(FName) - 4) & "_shapes.txt" 'txt檔名

    Set objStream = CreateObject("ADODB.Stream")
    objStream.Open
    objStream.Position = 0
    objStream.Charset = "UTF-8"
    
    For Each s In p.Slides
        For Each sh In s.Shapes
            If sh.HasTextFrame Then
                If sh.TextFrame.HasText Then
                    objStream.WriteText sh.TextFrame.TextRange.Text
                End If
            End If
        Next
    Next
    objStream.SaveToFile txtFname, 2
    objStream.Close
End Sub

它會把所有投影片中的文字取出後, 存在與 PPT 檔相同資料夾下,與 PPT 檔同名的 .TXT 文字檔中。

沒有留言: