Sub pptAsText()
Dim pApp As Object, pPres As Object
Dim pSlide As Object, pTxt As Object
Set pApp = CreateObject("powerpoint.Application")
pApp.Visible = True: Set pPres = pApp.Presentations.Add
pPres.PageSetup.SlideOrientation = _
IIf(ActiveDocument.PageSetup.Orientation = wdOrientPortrait, 2, 1)
ActiveDocument.Words(1).Select
For i = 1 To Selection.Information(wdNumberOfPagesInDocument)
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=i
Selection.GoTo What:=wdGoToBookmark, Name:="\page": Selection.Copy
Set pSlide = pPres.Slides.Add(pPres.Slides.Count + 1, 2)
Set pTxt = pSlide.Shapes(2)
pTxt.TextFrame.TextRange.ParagraphFormat.Bullet.Visible = False
pTxt.TextFrame.TextRange.Paste: pTxt.TextFrame.TextRange.Font.Size = 12
Next i
End Sub
کامنت