WinWord2WikkaWikiAction
Macro to convert WinWord docs to WikkaWiki markup.
Credits
Please note that this macro was not written by me.
I found it in http://www.wakatara.com/blog. In turn, Daryl Manning had found the original in http://infpro.com/projekte/wordwiki/
Credits go to both the above.
I merely made some mods to cater for WikkaWiki dialect differences.
Also, this is not a fully tested macro; Super/Subscript conversion does not apply to Wikka. Tables are not converted etc...
Usage
- Open the document you want to convert in WinWord
- Go to menu Tools/Macro/Macros.
- Entrer a name (Word2Wikka) in the Macro Name field. Press the Create button.
- Clear out whatever WinWord has entered and paste the code from below inside the newly created macro.
- Close the Microsoft Visual Basic window (this is the window that the new macro was created in).
- You are now back in the document you want to convert.
- Go to menu Tools/Macro/Macros.
- Select Word2Wikka and then press Run
- At this point the macro will
- Save your current document as <original name>.wiki.
- Convert the contents of the new document into Wikka markup.
Code
Sub Word2Wiki()
Dim docPath As String
Application.ScreenUpdating = False
docPath = ActiveDocument.Path & "\" & ActiveDocument.Name & ".wiki"
ActiveDocument.SaveAs (docPath)
' Application.Documents.Open (ActiveDocument.Name & ".wiki")
ReplaceQuotes
DokuWikiEscapeChars
DokuWikiConvertHyperlinks
DokuWikiConvertH1
DokuWikiConvertH2
DokuWikiConvertH3
DokuWikiConvertH4
DokuWikiConvertH5
DokuWikiConvertItalic
DokuWikiConvertBold
DokuWikiConvertUnderline
DokuWikiConvertStrikeThrough
' DokuWikiConvertSuperscript
' DokuWikiConvertSubscript
DokuWikiConvertLists
' Copy to clipboard
ActiveDocument.Content.Copy
Application.ScreenUpdating = True
End Sub
Private Sub DokuWikiConvertH1()
ReplaceHeading wdStyleHeading1, "======"
End Sub
Private Sub DokuWikiConvertH2()
ReplaceHeading wdStyleHeading2, "====="
End Sub
Private Sub DokuWikiConvertH3()
ReplaceHeading wdStyleHeading3, "===="
End Sub
Private Sub DokuWikiConvertH4()
ReplaceHeading wdStyleHeading4, "==="
End Sub
Private Sub DokuWikiConvertH5()
ReplaceHeading wdStyleHeading5, "=="
End Sub
Private Sub DokuWikiConvertH6()
ReplaceHeading wdStyleHeading5, "="
End Sub
Private Sub DokuWikiConvertBold()
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 Len(.Text) > 1 And 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 = ActiveDocument.Styles("Default Paragraph Font")
.Font.Bold = False
End With
Loop
End With
End Sub
Private Sub DokuWikiConvertItalic()
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 Len(.Text) > 1 And 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 = ActiveDocument.Styles("Default Paragraph Font")
.Font.Italic = False
End With
Loop
End With
End Sub
Private Sub DokuWikiConvertUnderline()
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 Len(.Text) > 1 And 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 = ActiveDocument.Styles("Default Paragraph Font")
.Font.Underline = False
End With
Loop
End With
End Sub
Private Sub DokuWikiConvertStrikeThrough()
ActiveDocument.Select
With Selection.Find
.ClearFormatting
.Font.StrikeThrough = True
.Text = ""
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
With Selection
If Len(.Text) > 1 And 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 = ActiveDocument.Styles("Default Paragraph Font")
.Font.StrikeThrough = False
End With
Loop
End With
End Sub
Private Sub DokuWikiConvertSuperscript()
ActiveDocument.Select
With Selection.Find
.ClearFormatting
.Font.Superscript = True
.Text = ""
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
With Selection
.Text = Trim(.Text)
If Len(.Text) > 1 And 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 "<sup>"
.InsertAfter "</sup>"
End If
.Style = ActiveDocument.Styles("Default Paragraph Font")
.Font.Superscript = False
End With
Loop
End With
End Sub
Private Sub DokuWikiConvertSubscript()
ActiveDocument.Select
With Selection.Find
.ClearFormatting
.Font.Subscript = True
.Text = ""
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
With Selection
.Text = Trim(.Text)
If Len(.Text) > 1 And 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 "<sub>"
.InsertAfter "</sub>"
End If
.Style = ActiveDocument.Styles("Default Paragraph Font")
.Font.Subscript = False
End With
Loop
End With
End Sub
Private Sub DokuWikiConvertLists()
Dim para As Paragraph
For Each para In ActiveDocument.ListParagraphs
With para.Range
.InsertBefore " "
If .ListFormat.ListType = wdListBullet Then
.InsertBefore "-"
Else
.InsertBefore "1)"
End If
For i = 1 To .ListFormat.ListLevelNumber
.InsertBefore " "
Next i
.ListFormat.RemoveNumbers
End With
Next para
End Sub
Private Sub DokuWikiConvertHyperlinks()
Dim hyperCount As Integer
hyperCount = ActiveDocument.Hyperlinks.Count
For i = 1 To hyperCount
With ActiveDocument.Hyperlinks(1)
Dim addr As String
addr = .Address
.Delete
.Range.InsertBefore "["
.Range.InsertAfter "-" & addr & "]"
End With
Next i
End Sub
' Replace all smart quotes with their dumb equivalents
Private Sub ReplaceQuotes()
Dim quotes As Boolean
quotes = Options.AutoFormatAsYouTypeReplaceQuotes
Options.AutoFormatAsYouTypeReplaceQuotes = False
ReplaceString ChrW(8220), """"
ReplaceString ChrW(8221), """"
ReplaceString "ë", "'"
ReplaceString "í", "'"
Options.AutoFormatAsYouTypeReplaceQuotes = quotes
End Sub
Private Sub DokuWikiEscapeChars()
EscapeCharacter "*"
EscapeCharacter "#"
'EscapeCharacter "_"
'EscapeCharacter "-"
'EscapeCharacter "+"
EscapeCharacter "{"
EscapeCharacter "}"
EscapeCharacter "["
EscapeCharacter "]"
EscapeCharacter "~"
EscapeCharacter "^^"
EscapeCharacter "|"
EscapeCharacter "'"
End Sub
Private Function ReplaceHeading(styleHeading As String, headerPrefix As String)
Dim normalStyle As Style
Set normalStyle = ActiveDocument.Styles(wdStyleNormal)
ActiveDocument.Select
With Selection.Find
.ClearFormatting
.Style = ActiveDocument.Styles(styleHeading)
.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 headerPrefix
.InsertBefore vbCr
.InsertAfter headerPrefix
End If
.Style = normalStyle
End With
Loop
End With
End Function
Private Function EscapeCharacter(char As String)
ReplaceString char, "\" & char
End Function
Private Function ReplaceString(findStr As String, replacementStr As String)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = findStr
.Replacement.Text = replacementStr
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Function
Dim docPath As String
Application.ScreenUpdating = False
docPath = ActiveDocument.Path & "\" & ActiveDocument.Name & ".wiki"
ActiveDocument.SaveAs (docPath)
' Application.Documents.Open (ActiveDocument.Name & ".wiki")
ReplaceQuotes
DokuWikiEscapeChars
DokuWikiConvertHyperlinks
DokuWikiConvertH1
DokuWikiConvertH2
DokuWikiConvertH3
DokuWikiConvertH4
DokuWikiConvertH5
DokuWikiConvertItalic
DokuWikiConvertBold
DokuWikiConvertUnderline
DokuWikiConvertStrikeThrough
' DokuWikiConvertSuperscript
' DokuWikiConvertSubscript
DokuWikiConvertLists
' Copy to clipboard
ActiveDocument.Content.Copy
Application.ScreenUpdating = True
End Sub
Private Sub DokuWikiConvertH1()
ReplaceHeading wdStyleHeading1, "======"
End Sub
Private Sub DokuWikiConvertH2()
ReplaceHeading wdStyleHeading2, "====="
End Sub
Private Sub DokuWikiConvertH3()
ReplaceHeading wdStyleHeading3, "===="
End Sub
Private Sub DokuWikiConvertH4()
ReplaceHeading wdStyleHeading4, "==="
End Sub
Private Sub DokuWikiConvertH5()
ReplaceHeading wdStyleHeading5, "=="
End Sub
Private Sub DokuWikiConvertH6()
ReplaceHeading wdStyleHeading5, "="
End Sub
Private Sub DokuWikiConvertBold()
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 Len(.Text) > 1 And 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 = ActiveDocument.Styles("Default Paragraph Font")
.Font.Bold = False
End With
Loop
End With
End Sub
Private Sub DokuWikiConvertItalic()
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 Len(.Text) > 1 And 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 = ActiveDocument.Styles("Default Paragraph Font")
.Font.Italic = False
End With
Loop
End With
End Sub
Private Sub DokuWikiConvertUnderline()
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 Len(.Text) > 1 And 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 = ActiveDocument.Styles("Default Paragraph Font")
.Font.Underline = False
End With
Loop
End With
End Sub
Private Sub DokuWikiConvertStrikeThrough()
ActiveDocument.Select
With Selection.Find
.ClearFormatting
.Font.StrikeThrough = True
.Text = ""
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
With Selection
If Len(.Text) > 1 And 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 = ActiveDocument.Styles("Default Paragraph Font")
.Font.StrikeThrough = False
End With
Loop
End With
End Sub
Private Sub DokuWikiConvertSuperscript()
ActiveDocument.Select
With Selection.Find
.ClearFormatting
.Font.Superscript = True
.Text = ""
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
With Selection
.Text = Trim(.Text)
If Len(.Text) > 1 And 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 "<sup>"
.InsertAfter "</sup>"
End If
.Style = ActiveDocument.Styles("Default Paragraph Font")
.Font.Superscript = False
End With
Loop
End With
End Sub
Private Sub DokuWikiConvertSubscript()
ActiveDocument.Select
With Selection.Find
.ClearFormatting
.Font.Subscript = True
.Text = ""
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
With Selection
.Text = Trim(.Text)
If Len(.Text) > 1 And 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 "<sub>"
.InsertAfter "</sub>"
End If
.Style = ActiveDocument.Styles("Default Paragraph Font")
.Font.Subscript = False
End With
Loop
End With
End Sub
Private Sub DokuWikiConvertLists()
Dim para As Paragraph
For Each para In ActiveDocument.ListParagraphs
With para.Range
.InsertBefore " "
If .ListFormat.ListType = wdListBullet Then
.InsertBefore "-"
Else
.InsertBefore "1)"
End If
For i = 1 To .ListFormat.ListLevelNumber
.InsertBefore " "
Next i
.ListFormat.RemoveNumbers
End With
Next para
End Sub
Private Sub DokuWikiConvertHyperlinks()
Dim hyperCount As Integer
hyperCount = ActiveDocument.Hyperlinks.Count
For i = 1 To hyperCount
With ActiveDocument.Hyperlinks(1)
Dim addr As String
addr = .Address
.Delete
.Range.InsertBefore "["
.Range.InsertAfter "-" & addr & "]"
End With
Next i
End Sub
' Replace all smart quotes with their dumb equivalents
Private Sub ReplaceQuotes()
Dim quotes As Boolean
quotes = Options.AutoFormatAsYouTypeReplaceQuotes
Options.AutoFormatAsYouTypeReplaceQuotes = False
ReplaceString ChrW(8220), """"
ReplaceString ChrW(8221), """"
ReplaceString "ë", "'"
ReplaceString "í", "'"
Options.AutoFormatAsYouTypeReplaceQuotes = quotes
End Sub
Private Sub DokuWikiEscapeChars()
EscapeCharacter "*"
EscapeCharacter "#"
'EscapeCharacter "_"
'EscapeCharacter "-"
'EscapeCharacter "+"
EscapeCharacter "{"
EscapeCharacter "}"
EscapeCharacter "["
EscapeCharacter "]"
EscapeCharacter "~"
EscapeCharacter "^^"
EscapeCharacter "|"
EscapeCharacter "'"
End Sub
Private Function ReplaceHeading(styleHeading As String, headerPrefix As String)
Dim normalStyle As Style
Set normalStyle = ActiveDocument.Styles(wdStyleNormal)
ActiveDocument.Select
With Selection.Find
.ClearFormatting
.Style = ActiveDocument.Styles(styleHeading)
.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 headerPrefix
.InsertBefore vbCr
.InsertAfter headerPrefix
End If
.Style = normalStyle
End With
Loop
End With
End Function
Private Function EscapeCharacter(char As String)
ReplaceString char, "\" & char
End Function
Private Function ReplaceString(findStr As String, replacementStr As String)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = findStr
.Replacement.Text = replacementStr
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Function
