Powerpoint Converter

This is a very quick and dirty script I wrote to export a powerpoint presentation into a single wiki page. Please feel free to use in any way you like, I'm no powerpoint expert so please feel free to repair my mangled code

How to Install

• Open a blank ppt deck.
• Open the VBA Editor
• Create a new module
• Cut/paste the vb code below

• Add a reference to your project (tools -> references) for the Microsoft Scripting Runtime (lets you do stuff with folders and files)

• Create a folder to export (default is c:\ppt) but you can choose your own - remember to update it in the vb code!

How to use

• Open the ppt you want to export
• Switch over to the vb editor window where you pasted this macro
• Hit run
• browse to the C:\ppt folder
• Cut / paste the contents of the wiki.txt into your wiki page
• manually upload the images, or cheat and copy them into the attachments folder on the server for your page

Best of luck!

-- CliftonCunningham 2007-02-10 10:04:22

Sub ExportToWiki()

    ' Very quick and dirty powerpoint export macro, exports as one page with headers for each slide.
    ' Images are exported as png's so you can just copy them all over to the pages attachments folder.
    ' Author: Clifton.cunningham at gmail.com
    ' Date: 08/02/2006
    '
    ' Comments:
    ' Please feel free to use how you will, but it would be great if you can send me any updates you make!
    ' I save this macro in a blank ppt called wikiexport, I then open up and make active
    ' the ppt I want to export, and run this.  Cut paste the text in wiki.txt onto a new wiki page, copy over the images.
    ' you need to import the Microsoft.ScriptingRuntime to allow this to work.
    ' You should add a css class called .tableheader to your theme as my table headers use this style
    ' REMEMBER To set the Outpath - create it first!

    ' The folder you want to dump everything in
    Dim outPath As String
    outPath = "C:\ppt"

    ' Iterators
    Dim i As Integer
    Dim j As Integer
    
    ' Pres, Slide, Shape
    Dim aPres As Presentation
    Dim aSlide As Slide
    Dim aShape As Shape
    
    ' File Handling
    Dim oFileSystem As Scripting.FileSystemObject
    Dim oFileStream As Scripting.TextStream
    Dim oFolder As Scripting.Folder
    Dim oFile As Scripting.File
    Dim outText As String
    
    ' Table exports
    Dim row As Integer
    Dim col As Integer
    Dim cellText As String
    
    ' Create scripting object
    Set oFileSystem = New Scripting.FileSystemObject
    
    ' Clear the old ppt folder
    Set oFolder = oFileSystem.GetFolder(outPath)
    For Each oFile In oFolder.Files
        oFile.Delete (True)
    Next oFile
    
    ' Set up my text file writer for my wiki text
    Set oFileStream = oFileSystem.CreateTextFile(outPath + "\wiki.txt", True, False)
    
    ' Select my ppt
    Set pPres = Application.ActivePresentation
    
    ' Write TOC
    oFileStream.WriteLine ("[[TableOfContents]]")
    
    ' Loop through slides
    For i = 1 To pPres.Slides.Count
        
        Set aSlide = pPres.Slides(i)
                
        ' Loop through shapes
        For j = 1 To aSlide.Shapes.Count
                       
            Set aShape = aSlide.Shapes(j)
            
            ' Is it a text frame?
            If aShape.HasTextFrame Then
 
                If aShape.TextFrame.HasText Then
                                            
                    outText = aShape.TextFrame.TextRange.Text
                    
                    ' Check for bullets
                    If aShape.TextFrame.TextRange.ParagraphFormat.Bullet = msoTrue Then
                        outText = Replace(outText, Chr(10), " * ")
                    End If
                    
                    If j = 1 Then ' Assume first text is always the header
                        outText = "= " + outText + " ="
                     End If
                    
                     oFileStream.WriteLine (outText + Chr(13) + "[[BR]]" + Chr(13))
                                        
                End If
                                
            End If
            
            ' Is it a table?
            If aShape.Type = msoTable Then
                
                cellText = ""
                
                For row = 1 To aShape.Table.Rows.Count
                    For col = 1 To aShape.Table.Columns.Count
                                                
                        If row = 1 Then
                            cellText = cellText + "||<class=" + Chr(34) + "tableheader" + Chr(34) + ">" + aShape.Table.Columns.Item(col).Cells(row).Shape.TextFrame.TextRange.Text
                        Else
                            cellText = cellText + "||" + aShape.Table.Columns.Item(col).Cells(row).Shape.TextFrame.TextRange.Text
                        End If
                        
                        If col = aShape.Table.Columns.Count Then
                            cellText = cellText + "||" + Chr(13)
                        End If
                        
                    Next col
                Next row
                
                oFileStream.WriteLine (Chr(13) + cellText + Chr(13))
                
            End If
                        
            ' Is it a picture or embedded object
            If aShape.Type = msoPicture Or aShape.Type = msoEmbeddedOLEObject Or aShape.Type = msoLinkedPicture Or aShape.Type = msoGroup Then
                aShape.Export outPath + "\image" + Trim(Str(i)) + Trim(Str(j)) + ".png", ppShapeFormatPNG
                oFileStream.WriteLine (Chr(13) + "attachment:image" + Trim(Str(i)) + Trim(Str(j)) + ".png" + Chr(13))
            End If
    
                
        Next j
    Next i
    
    oFileStream.Close
    Set oFile = Nothing

End Sub