0

I'm trying to turn a Microsoft Word Document into a Powerpoint Presentation. I have tried pasting as a picture to keep the same format as the Word Document, using the link below as a reference, as pasting normally was causing major formatting issues with pictures and texts spread out across the whole slide. However pasting using mySlide.CommandBars.ExecuteMso "PasteAsPicture", it sometimes misses pictures and text, or copies and pastes it twice and when pasting tables the formatting is all off. I have tried slowing the pasting down but that also did not seem to work. Does the community have ideas?

How to Copy/Paste text box from MS Word to Powerpoint slide?

Sub WordToPowerPoint()

Dim rgePages As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object

  On Error Resume Next

For Each oCC In ActiveDocument.ContentControls
        If oCC.Title = "FilePath12" Then
            fPath = oCC.Range.Text
        End If
        Next oCC

    Set pptApp = CreateObject("PowerPoint.Application")
      Set PowerPointApp = GetObject(Class:="PowerPoint.Application")
    
      err.Clear

      If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(Class:="PowerPoint.Application")

      If err.Number = 429 Then
        MsgBox "PowerPoint could not be found, aborting."
        Exit Sub
      End If

  On Error GoTo 0

  Set myPresentation = PowerPointApp.presentations.Add
  
a = ActiveDocument.BuiltInDocumentProperties("Number of Pages")
For x = 1 To a

Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=x
Set rgePages = Selection.Range

rgePages.End = Selection.Bookmarks("\Page").Range.End
rgePages.Select

On Error Resume Next

    Selection.Copy
    Selection.CopyFormat
  
  Application.ScreenUpdating = False

 Set mySlide = myPresentation.Slides.Add(x, 12)

  Set mySlide = myPresentation.Slides(x)
  mySlide.Select

mySlide.ApplyTheme fPath
  pptApp.CommandBars.ExecuteMso "PasteAsPicture"
  
  Dim time1, time2

time1 = Now
time2 = Now + TimeValue("0:00:01")
    Do Until time1 >= time2
        DoEvents
        time1 = Now()
    Loop

Next x

End Sub
4
  • I/O operations (copy, paste, save, open, etc) run more slowly than VBA does. So you have to insert timing commands to slow down your macro. Search online for Wait, Sleep and DoEvents. Aug 6, 2020 at 16:40
  • Hi John, thank you! I tried slowing it done to 10 seconds using a DoEvent, but still the same result. I also tried CommandBars.ReleaseFocus after Execure MSO but again still the same result.
    – clove201
    Aug 10, 2020 at 8:39
  • Oh my - my mistake - sorry please - its for publisher.
    – G. N. MS
    Aug 10, 2020 at 10:56
  • Wait, Sleep and DoEvents all work differently. If DoEvents doesn't have the desired effect, try one of the others. Here's a page with more details: myonlinetraininghub.com/… Aug 10, 2020 at 17:14

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Browse other questions tagged or ask your own question.