[Foundation-l] Macro for converting word documents to wikipedia markup and wysiwyg for wikipedia - Wikimedia-l

5 May 2005

I am trying to get non-wiki-savvy authors to contribute to a relatively new
wikibook (Emergency Medicine), and I need a macro which can easily convert
word documents with formatting (Heading1, etc.) into wiki markup. There are
macros out there for other types of wiki markup (I've attached one to this
email - it converts word to modwiki) but not for the kind of wiki markup we
use on wikipedia, wikibooks, etc. Can anyone point out an existing macro, or
can anyone tweak this attached macro? 

Oh, also, is there a wysiwyg for wikipedia markup?

Would much appreciate,

Paris Lovett.

P.s. if I'm writing to the wrong place, please let me know where to write
to. Thanks.

----------------------

Sub WordToUseModWiki()

    Application.ScreenUpdating = False

    ConvertH1
    ConvertH2
    ConvertH3

    ConvertItalic
    ConvertBold
    ConvertUnderline

    ConvertLists

    ConvertCarriageReturns

    ConvertTables

    ' Copy to clipboard
    ActiveDocument.Content.Copy

    Application.ScreenUpdating = True
End Sub

Private Sub ConvertCarriageReturns()
    ActiveDocument.Content.Find.ClearFormatting
    ActiveDocument.Content.Find.Execute FindText:="^p",
ReplaceWith:="^p^p",
Format:=True, Replace:=wdReplaceAll, MatchControl:=True
End Sub

Private Sub ConvertH1()
    Dim normalStyle As Style
    Set normalStyle = ActiveDocument.Styles(wdStyleNormal)

    ActiveDocument.Select

    With Selection.Find

        .ClearFormatting
        .Style = ActiveDocument.Styles(wdStyleHeading1)
        .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 "= "
                    .InsertAfter " ="
                End If

                .Style = normalStyle
            End With
        Loop
    End With
End Sub

Private Sub ConvertH2()
    Dim normalStyle As Style
    Set normalStyle = ActiveDocument.Styles(wdStyleNormal)

    ActiveDocument.Select

    With Selection.Find

        .ClearFormatting
        .Style = ActiveDocument.Styles(wdStyleHeading2)
        .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 "== "
                    .InsertAfter " =="
                End If

                .Style = normalStyle
            End With
        Loop
    End With
End Sub

Private Sub ConvertH3()
    Dim normalStyle As Style
    Set normalStyle = ActiveDocument.Styles(wdStyleNormal)

    ActiveDocument.Select

    With Selection.Find

        .ClearFormatting
        .Style = ActiveDocument.Styles(wdStyleHeading3)
        .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 "=== "
                    .InsertAfter " ==="
                End If

                .Style = normalStyle
            End With
        Loop
    End With
End Sub

Private Sub ConvertBold()
    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 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 "<b>"
                    .InsertAfter "</b>"
                End If

                .Font.Bold = False
            End With
        Loop
    End With
End Sub

Private Sub ConvertItalic()
    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 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 "<i>"
                    .InsertAfter "</i>"
                End If

                .Font.Italic = False
            End With
        Loop
    End With
End Sub

Private Sub ConvertUnderline()
    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 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 "<i>"
                    .InsertAfter "</i>"
                End If

                .Font.Underline = False
            End With
        Loop
    End With
End Sub

Private Sub ConvertLists()
    Dim para As Paragraph
    For Each para In ActiveDocument.ListParagraphs
        With para.Range
            If .ListFormat.ListType = wdListBullet Then
                .InsertBefore "*"
            Else
                .InsertBefore "#"
            End If

            .ListFormat.RemoveNumbers
        End With
    Next para
End Sub

Private Sub ConvertTables()
    Dim thisTable As Table
    Dim thisRow As Row
    Dim thisCell As Cell
    For Each thisTable In ActiveDocument.Tables
            For Each thisRow In thisTable.Rows
                For Each thisCell In thisRow.Cells
                    thisCell.Range.InsertBefore "||"
                    thisCell.Range.Find.Execute FindText:="^p",
ReplaceWith:=" ", Format:=True, Replace:=wdReplaceAll, MatchControl:=True
                Next thisCell
                    thisRow.Range.InsertAfter "||"
            Next thisRow
            thisTable.ConvertToText Separator:=" "
    Next thisTable
End Sub