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
