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