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

[Paris Lovett]

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
-------------- next part --------------
An embedded and charset-unspecified text was scrubbed...
Name: Word2Wiki.bas.txt
Url: http://lists.wikimedia.org/pipermail/foundation-l/attachments/20050505/60e6fa6c/attachment-0001.txt