Word To Wiki

From BriansWiki

Jump to: navigation, search

I found a cool site that has a macro to convert word documents into Wiki format: http://meta.wikimedia.org/wiki/Word_macros It works really well I think, you can look at the Web Developer System Setup page as an example. I had to "fix" the hyperlink conversion routine since it didn't work as advertised. The modified macro if listed below if anyone wants it. The question is "is this simple enough to hand to a non-technical person and let them add content?

[edit] Usage

To use this MicroSoft Word to Wiki convertor copy the code below and save it to word2wiki.bas.

  • Open your word document and then hit Alt+F11.
  • Select the 'Normal' template from the tree control on the left (so that every page has this macro).
  • Then select File -> Import File from the main menu.
  • Select the file you have just saved.
  • Close the Visual Basic screen.
  • Then in your Word document select Alt+F8.
  • You should see a Macro named 'WordToMediaWiki' in the list; select it and then click on 'Run'
  • The convertor will do its job and should automatically copy the conversion into the clipboard (just like selecting 'Edit' - 'Copy' from the main menu).
  • All you then need to do is to paste into your editor in MediaWiki.

This convertor is not perfect and I am not a Visual Basic programmer, so any enhancements or refinements are most welcome.

[edit] Code

Right click on this link and choose 'save target as' or 'save link as' (depending on your browser) and rename the file to 'Word2MediaWiki.bas'.

Here's the code if you are interested:

NOTE: There have been some recent changes suggested by Ton Kramer of Bosch Thermotechnology (thanks Ton!). You should note that the default template may need to be localized; in this code it assumes you have "Normal" style - this may need to be changed to a local string (in Dutch it is "Standaard" apparently). 

Sub Word2MediaWiki()
    Application.ScreenUpdating = False
    ReplaceQuotes
    RemovePageBreaks
    MediaWikiEscapeChars
    MediaWikiConvertHyperlinks
    MediaWikiConvertH1
    MediaWikiConvertH2
    MediaWikiConvertH3
    MediaWikiConvertH4
    MediaWikiConvertH5
    MediaWikiConvertItalic
    MediaWikiConvertBold
    MediaWikiConvertUnderline
    MediaWikiConvertStrikeThrough
    MediaWikiConvertSuperscript
    MediaWikiConvertSubscript
    MediaWikiConvertLists
    MediaWikiConvertTables
    ' Copy to clipboard
   ActiveDocument.Content.Copy
   Application.ScreenUpdating = True
End Sub
 
Private Sub MediaWikiConvertH1()
    ReplaceHeading wdStyleHeading1, "="
End Sub
 
Private Sub MediaWikiConvertH2()
    ReplaceHeading wdStyleHeading2, "=="
End Sub
 
Private Sub MediaWikiConvertH3()
    ReplaceHeading wdStyleHeading3, "==="
End Sub
 
Private Sub MediaWikiConvertH4()
    ReplaceHeading wdStyleHeading4, "===="
End Sub
 
Private Sub MediaWikiConvertH5()
    ReplaceHeading wdStyleHeading5, "====="
End Sub
 
Private Sub MediaWikiConvertBold()
    ActiveDocument.Select
    With Selection.Find
 
  
 
        .ClearFormatting
 
        .Font.Bold = True
 
        .Text = ""
 
      
 
        .Format = True
 
        .MatchCase = False
 
        .MatchWholeWord = False
 
        .MatchWildcards = False
 
        .MatchSoundsLike = False
 
        .MatchAllWordForms = False
 
      
 
        .Forward = True
 
        .Wrap = wdFindContinue
 
      
 
        Do While .Execute
 
            With Selection
 
                If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then
 
                    ' Just process the chunk before any newline characters
 
                    ' We'll pick-up the rest with the next search
 
                    .Collapse
 
                    .MoveEndUntil vbCr
 
                End If
 
                                     
 
                ' Don't bother to markup newline characters (prevents a loop, as well)
 
                If Not .Text = vbCr Then
 
                    .InsertBefore "'''"
 
                    .InsertAfter "'''"
 
                End If
 
              
 
                .Style = ActiveDocument.Styles("Normal")
 
                .Font.Bold = False
 
            End With
 
        Loop
 
    End With
 
End Sub
 
 
 
Private Sub MediaWikiConvertItalic()
 
    ActiveDocument.Select
 
  
 
    With Selection.Find
 
  
 
        .ClearFormatting
 
        .Font.Italic = True
 
        .Text = ""
 
      
 
        .Format = True
 
        .MatchCase = False
 
        .MatchWholeWord = False
 
        .MatchWildcards = False
 
        .MatchSoundsLike = False
 
        .MatchAllWordForms = False
 
      
 
        .Forward = True
 
        .Wrap = wdFindContinue
 
      
 
        Do While .Execute
 
            With Selection
 
                If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then
 
                    ' Just process the chunk before any newline characters
 
                    ' We'll pick-up the rest with the next search
 
                    .Collapse
 
                    .MoveEndUntil vbCr
 
                End If
 
                                     
 
                ' Don't bother to markup newline characters (prevents a loop, as well)
 
                If Not .Text = vbCr Then
 
                    .InsertBefore "''"
 
                    .InsertAfter "''"
 
                End If
 
              
 
                .Style = ActiveDocument.Styles("Normal")
 
                .Font.Italic = False
 
            End With
 
        Loop
 
    End With
 
End Sub
 
 
 
Private Sub MediaWikiConvertUnderline()
 
    ActiveDocument.Select
 
  
 
    With Selection.Find
 
  
 
        .ClearFormatting
 
        .Font.Underline = True
 
        .Text = ""
 
      
 
        .Format = True
 
        .MatchCase = False
 
        .MatchWholeWord = False
 
        .MatchWildcards = False
 
        .MatchSoundsLike = False
 
        .MatchAllWordForms = False
 
      
 
        .Forward = True
 
        .Wrap = wdFindContinue
 
      
 
        Do While .Execute
 
            With Selection
 
                If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then
 
                    ' Just process the chunk before any newline characters
 
                    ' We'll pick-up the rest with the next search
 
                    .Collapse
 
                    .MoveEndUntil vbCr
 
                End If
 
                                      
 
                ' Don't bother to markup newline characters (prevents a loop, as well)
 
                If Not .Text = vbCr Then
 
                    .InsertBefore "<u>"
 
                    .InsertAfter "</u>"
 
                End If
 
               
 
                .Style = ActiveDocument.Styles("Normal")
 
                .Font.Underline = False
 
            End With
 
        Loop
 
    End With
 
End Sub
 
 
 
Private Sub MediaWikiConvertStrikeThrough()
 
    ActiveDocument.Select
 
  
 
    With Selection.Find
 
  
 
        .ClearFormatting
 
        .Font.StrikeThrough = True
 
        .Text = ""
 
      
 
        .Format = True
 
        .MatchCase = False
 
        .MatchWholeWord = False
 
        .MatchWildcards = False
 
        .MatchSoundsLike = False
 
        .MatchAllWordForms = False
 
      
 
        .Forward = True
 
        .Wrap = wdFindContinue
 
      
 
        Do While .Execute
 
            With Selection
 
                If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then
 
                    ' Just process the chunk before any newline characters
 
                    ' We'll pick-up the rest with the next search
 
                    .Collapse
 
                    .MoveEndUntil vbCr
 
                End If
 
                                     
 
                ' Don't bother to markup newline characters (prevents a loop, as well)
 
                If Not .Text = vbCr Then
 
                    .InsertBefore("<s>")
 
                    .InsertAfter("</s>")
 
                End If
 
              
 
                .Style = ActiveDocument.Styles("Normal")
 
                .Font.StrikeThrough = False
 
            End With
 
        Loop
 
    End With
 
End Sub
 
 
 
Private Sub MediaWikiConvertSuperscript()
 
    ActiveDocument.Select
 
  
 
    With Selection.Find
 
  
 
        .ClearFormatting
 
        .Font.Superscript = True
 
        .Text = ""
 
      
 
        .Format = True
 
        .MatchCase = False
 
        .MatchWholeWord = False
 
        .MatchWildcards = False
 
        .MatchSoundsLike = False
 
        .MatchAllWordForms = False
 
      
 
        .Forward = True
 
        .Wrap = wdFindContinue
 
      
 
        Do While .Execute
 
            With Selection
 
                .Text = Trim(.Text)
 
                If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then
 
                    ' Just process the chunk before any newline characters
 
                    ' We'll pick-up the rest with the next search
 
                    .Collapse
 
                    .MoveEndUntil vbCr
 
                End If
 
                                      
 
                ' Don't bother to markup newline characters (prevents a loop, as well)
 
                If Not .Text = vbCr Then
 
                    .InsertBefore("<sup>")
 
                    .InsertAfter("</sup>")
 
                End If
 
               
 
                .Style = ActiveDocument.Styles("Normal")
 
                .Font.Superscript = False
 
            End With
 
        Loop
 
    End With
 
End Sub
 
 
 
Private Sub MediaWikiConvertSubscript()
 
    ActiveDocument.Select
 
  
 
    With Selection.Find
 
  
 
        .ClearFormatting
 
        .Font.Subscript = True
 
        .Text = ""
 
      
 
        .Format = True
 
        .MatchCase = False
 
        .MatchWholeWord = False
 
        .MatchWildcards = False
 
        .MatchSoundsLike = False
 
        .MatchAllWordForms = False
 
      
 
        .Forward = True
 
        .Wrap = wdFindContinue
 
      
 
        Do While .Execute
 
            With Selection
 
                .Text = Trim(.Text)
 
                If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then
 
                    ' Just process the chunk before any newline characters
 
                    ' We'll pick-up the rest with the next search
 
                    .Collapse
 
                    .MoveEndUntil vbCr
 
                End If
 
                                      
 
                ' Don't bother to markup newline characters (prevents a loop, as well)
 
                If Not .Text = vbCr Then
 
                    .InsertBefore("<sub>")
 
                    .InsertAfter("</sub>")
 
                End If
 
              
 
                .Style = ActiveDocument.Styles("Normal")
 
                .Font.Subscript = False
 
            End With
 
        Loop
 
    End With
 
End Sub
 
 
 
Private Sub MediaWikiConvertLists()
 
    Dim para As Paragraph
 
    For Each para In ActiveDocument.ListParagraphs
 
        With para.Range
 
            .InsertBefore " "
 
            For i = 1 To .ListFormat.ListLevelNumber
 
                If .ListFormat.ListType = wdListBullet Then
 
                    .InsertBefore "*"
 
                Else
 
                    .InsertBefore "#"
 
                End If
 
            Next i
 
            .ListFormat.RemoveNumbers
 
        End With
 
    Next para
 
End Sub
 
 
 
Private Sub MediaWikiConvertTables()
 
    Dim thisTable As Table
 
    For Each thisTable In ActiveDocument.Tables
 
        With thisTable
 
            For Each aRow In thisTable.Rows
 
                With aRow
 
                For Each aCell In aRow.Cells
 
                    With aCell
 
                        If aCell.Range.Text = Chr(13) & Chr(7) Then
 
                            ' empty cell. Add non-breaking space character
                            aCell.Range.Text = " "
 
                        End If
 
                        ' Replace newlines in cell with <br/>
                        aCell.Range.Text = Replace(aCell.Range.Text, ChrW(11), "<br/> ")
 
                        aCell.Range.InsertBefore "|"
 
                        'aCell.Range.InsertAfter "|"
 
                    End With
 
                Next aCell
 
                '.Range.InsertBefore "|"
 
                .Range.InsertAfter vbCrLf + "|-"
 
                End With
 
            Next aRow
 
        .Range.InsertBefore "{| border=1" + vbCrLf
 
        .Range.InsertAfter vbCrLf + "|}"
 
        .ConvertToText "|"
 
        End With
 
    Next thisTable
 
End Sub
 
 
 
Private Sub MediaWikiConvertHyperlinks()
 
    Dim hyperCount As Integer
 
  
 
    hyperCount = ActiveDocument.Hyperlinks.Count
 
  
 
    For i = 1 To hyperCount
 
        With ActiveDocument.Hyperlinks(1)
 
            Dim addr As String
 
            addr = .Address
 
            .Delete
 
            .Range.InsertBefore "["
 
            .Range.InsertAfter "-" & addr & "]"
 
        End With
 
    Next i
 
End Sub
 
Private Sub RemovePageBreaks()
    ReplaceString "^m", ""
End Sub
 
 
' Replace all smart quotes with their dumb equivalents
 
Private Sub ReplaceQuotes()
 
    Dim quotes As Boolean
 
    quotes = Options.AutoFormatAsYouTypeReplaceQuotes
 
    Options.AutoFormatAsYouTypeReplaceQuotes = False
 
    ReplaceString ChrW(8220), """"
 
    ReplaceString ChrW(8221), """"
 
    ReplaceString "‘", "'"
 
    ReplaceString "’", "'"
 
    Options.AutoFormatAsYouTypeReplaceQuotes = quotes
 
End Sub
 
 
 
Private Sub MediaWikiEscapeChars()
 
    EscapeCharacter "*"
 
    EscapeCharacter "#"
 
    'EscapeCharacter "_"
 
    'EscapeCharacter "-"
 
    'EscapeCharacter "+"
 
    EscapeCharacter "{"
 
    EscapeCharacter "}"
 
    EscapeCharacter "["
 
    EscapeCharacter "]"
 
    EscapeCharacter "~"
 
    EscapeCharacter "^^"
 
    EscapeCharacter "|"
 
    'EscapeCharacter "'"
 
End Sub
 
 
 
Private Function ReplaceHeading(styleHeading As String, headerPrefix As String)
 
    Dim normalStyle As Style
 
    Set normalStyle = ActiveDocument.Styles(wdStyleNormal)
 
  
 
    ActiveDocument.Select
 
  
 
    With Selection.Find
 
  
 
        .ClearFormatting
 
        .Style = ActiveDocument.Styles(styleHeading)
 
        .Text = ""
 

      
 
        .Format = True
 
        .MatchCase = False
 
        .MatchWholeWord = False
 
        .MatchWildcards = False
 
        .MatchSoundsLike = False
 
        .MatchAllWordForms = False
 
      
 
        .Forward = True
 
        .Wrap = wdFindContinue
 
      
 
        Do While .Execute
 
            With Selection
 
                If InStr(1, .Text, vbCr) Then
 
                    ' Just process the chunk before any newline characters
 
                    ' We'll pick-up the rest with the next search
 
                    .Collapse
 
                    .MoveEndUntil vbCr
 
                End If
 
                                      
 
                ' Don't bother to markup newline characters (prevents a loop, as well)
                If Not .Text = vbCr Then
                    .InsertBefore headerPrefix
                    .InsertBefore vbCr
                    .InsertAfter headerPrefix
                End If
                .Style = normalStyle
            End With
        Loop
    End With
End Function
 
Private Function EscapeCharacter(char As String)
    ReplaceString char, "\" & char
End Function
 
Private Function ReplaceString(findStr As String, replacementStr As String)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = findStr
        .Replacement.Text = replacementStr
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Function
Retrieved from "http://briancaufield.com/index.php?title=Word_To_Wiki"
Personal tools