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 文字檔中。
沒有留言:
張貼留言