[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