Converting A PPT To Word Using VBA Macros

I was tinkering with an idea and thought that I would pass this on to you all just in case you could use it.

I create all of my walkthroughs and scripts in PPT (just in case I want to use them in presentations, and also they look tidy).

But if I want to use them as a blog post or create a white paper on them then I have to transfer all of the images and text by hand – the export as handouts does not export out the images and text in a way that they can be reformatted in Word.

So I looked around and found one PPT Macro that would walk through the PPT and convert it into a Word document element by element.  I tinkered with it and created the following Macro:

 

Sub WriteToWord()

Dim aSlide As Slide

Dim aTable As Table

Dim aShape As Shape

Dim TablesCount As Integer

Dim ShapesCount As Integer

Dim MyDoc As New Word.Document

Dim MyRange As Word.Range

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 msoTextBox

aShape.TextFrame.TextRange.Copy

MyRange.Paste

With MyRange

.ParagraphFormat.Alignment = wdAlignParagraphLeft

.ParagraphStyle = “Normal”

.Font.ColorIndex = wdBlack

End With

Case msoAutoShape

If aShape.TextFrame.HasText Then

aShape.TextFrame.TextRange.Copy

MyRange.Paste

With MyRange

.ParagraphFormat.Alignment = wdAlignParagraphLeft

.ParagraphStyle = “Normal”

.Font.ColorIndex = wdBlack

End With

Else

aShape.Copy

MyRange.PasteSpecial DataType:=wdPasteMetafilePicture

ShapesCount = .Shapes.Count

With .Shapes(ShapesCount)

.LockAspectRatio = msoTrue

.ConvertToInlineShape

End With

End If

Case msoPlaceholder

Select Case aShape.PlaceholderFormat.ContainedType

Case msoAutoShape

If aShape.TextFrame.HasText Then

aShape.TextFrame.TextRange.Copy

MyRange.Paste

With MyRange

.ParagraphFormat.Alignment = wdAlignParagraphLeft

.ParagraphStyle = “Normal”

.Font.ColorIndex = wdBlack

End With

Else

aShape.Copy

MyRange.PasteSpecial DataType:=wdPasteMetafilePicture

ShapesCount = .Shapes.Count

With .Shapes(ShapesCount)

.LockAspectRatio = msoTrue

.ConvertToInlineShape

End With

End If

Case msoPicture

aShape.Copy

MyRange.PasteSpecial DataType:=wdPasteMetafilePicture

ShapesCount = .Shapes.Count

With .Shapes(ShapesCount)

.LockAspectRatio = msoTrue

.ConvertToInlineShape

End With

Case msoTextBox

aShape.TextFrame.TextRange.Copy

MyRange.Paste

With MyRange

.ParagraphFormat.Alignment = wdAlignParagraphLeft

.ParagraphStyle = “Normal”

.Font.ColorIndex = wdBlack

End With

End Select

.Content.InsertAfter Chr(13)

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

.Content.InsertAfter Chr(13)

End Select

Next

If aSlide.SlideIndex < ActivePresentation.Slides.Count Then

.Content.InsertAfter Chr(13)

End If

.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

It’s not perfect, but it does scrape the PPT and create a Word document:

All that is left to do is format it which is the easy part.

If anyone knows how to create Add-Ins for PPT and code this in Visual Studio then I will hand over full rights to this idea as long as I can use it 😉