Mailing List Archive

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