Consulting

Results 1 to 9 of 9

Thread: Powerpoint to Word

  1. #1
    VBAX Contributor
    Joined
    Oct 2004
    Posts
    159
    Location

    Powerpoint to Word (Not Question)

    The code below, quoted from China, convert PPT to Word.
    Set reference to Microsoft Word XX Object Library
    Enjoy

    [vba]
    Option Explicit
    Sub WriteToWord()
    Dim aSlide As Slide, MyDoc As New Word.Document, MyRange As Word.Range
    Dim aTable As Table, aShape As Shape, TablesCount As Integer, ShapesCount As Integer
    Dim i As Word.Paragraph
    On Error Resume Next
    With MyDoc
    .Application.Visible = False
    .Application.ScreenUpdating = False
    For Each aSlide In ActivePresentation.Slides
    For Each aShape In aSlide.Shapes
    Set MyRange = .Range(.Content.End - 1, .Content.End - 1)
    Select Case aShape.Type
    Case msoAutoShape, msoPlaceholder, msoTextBox
    If aShape.TextFrame.HasText Then
    aShape.TextFrame.TextRange.Copy
    MyRange.Paste
    With MyRange
    .ParagraphFormat.Alignment = wdAlignParagraphLeft
    For Each i In MyRange.Paragraphs
    If i.Range.Font.Size >= 16 Then
    i.Range.Font.Size = 14
    Else
    i.Range.Font.Size = 12
    End If
    Next
    End With
    End If
    Case msoPicture
    aShape.Copy
    MyRange.PasteSpecial DataType:=wdPasteMetafilePicture
    ShapesCount = .Shapes.Count
    With .Shapes(ShapesCount)
    .LockAspectRatio = msoFalse
    .Width = Word.CentimetersToPoints(14)
    .Height = Word.CentimetersToPoints(6)
    .Left = wdShapeCenter
    .ConvertToInlineShape
    End With
    .Content.InsertAfter Chr(13)
    Case msoEmbeddedOLEObject, msoLinkedOLEObject, msoLinkedPicture, msoOLEControlObject
    aShape.Copy
    MyRange.PasteSpecial DataType:=wdPasteOLEObject
    ShapesCount = .Shapes.Count
    With .Shapes(ShapesCount)
    .LockAspectRatio = msoFalse
    .Width = Word.CentimetersToPoints(14)
    .Height = Word.CentimetersToPoints(6)
    .Left = wdShapeCenter
    .ConvertToInlineShape
    End With
    .Content.InsertAfter Chr(13)
    Case msoTable
    aShape.Copy
    MyRange.Paste
    TablesCount = .Tables.Count
    With .Tables(TablesCount)
    .PreferredWidthType = wdPreferredWidthPercent
    .PreferredWidth = 100
    .Range.Font.Size = 11
    End With
    .Content.InsertAfter Chr(13)
    End Select
    Next
    If aSlide.SlideIndex < ActivePresentation.Slides.Count Then .Content.InsertAfter Chr(12)
    .UndoClear ' Clear used memory
    Next
    With .Content.Find
    .ClearFormatting
    .Format = True
    .Font.Color = wdColorWhite
    .Replacement.Font.Color = wdColorAutomatic
    .Execute Replace:=wdReplaceAll
    End With
    MsgBox "PPT Converted to WORD completed", vbInformation + vbOKOnly, "ExcelHome/ShouRou"
    .Application.Visible = True
    .Application.ScreenUpdating = True
    End With
    End Sub
    [/vba]
    Last edited by Emily; 04-28-2006 at 09:34 AM.

  2. #2
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    Thanks Emily, that works nicely. Don't forget to mention to new users that a reference has to be set to the Microsoft Word vXX object library....
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  3. #3
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    Please consider submitting this to our Knowledgebase. Access with Kbase link at the top of the page.
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  4. #4
    VBAX Contributor
    Joined
    Oct 2004
    Posts
    159
    Location
    I think I am not the appropriate person to submit as KB.
    I just want to share the writer's experinence.

  5. #5
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    Submit the entry and give them credit for it in the discussion section of the entry......
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  6. #6
    VBAX Contributor
    Joined
    Oct 2004
    Posts
    159
    Location
    Informed orginial writer and submitted with ppa attachment

    Code added
    [VBA]
    Sub Auto_Open() ' Add PPTtoWord to Tool Bar when Powerpoint start
    Dim MyControl As CommandBarControl
    On Error Resume Next
    Application.CommandBars("Standard").Controls("PPTtoWord").Delete
    Set MyControl = Application.CommandBars("Standard").Controls.Add(Before:=1)
    With MyControl
    .Caption = "PPTtoWord"
    .FaceId = 567 ' Word Icon
    .Enabled = True
    .Visible = True
    .Width = 100
    .OnAction = "WriteToWord"
    .Style = msoButtonIconAndCaption
    End With
    End Sub
    Sub Auto_Close() ' Delete PPTtoWord from Tool Bar when Powerpoint close
    On Error Resume Next
    Application.CommandBars("Standard").Controls("PPTtoWord").Delete
    End Sub

    [/VBA]

    Regards.
    Emily

  7. #7
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    Hi Emily,
    For some reason this is not showing up in the approvers forum as submitted. The forum has undergone a recent upgrade and that could be part of it.

    It is also possible that you left it in wip (work in progress) at the bottom of the submit page. Look for a drop down box and select "for approval" then save .......please disregard if you've already done this but let me know so I can do something about it.
    Thanks,
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  8. #8
    VBAX Contributor
    Joined
    Oct 2004
    Posts
    159
    Location
    Sorry,
    I left it as WIP previously

  9. #9
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    Sorry Emily, its still wip and I can't approve it until you set it to for approval and click save at the bottom of the entry....will approve it as I have already looked it over and it looks good.

    Might tell users how to put it in the directory where it can be found as an addin. Works great though and I look forward to approving it for you.
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •