=====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====

%%(vb)

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 "^{"
.InsertAfter "}"
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 "_{"
.InsertAfter "}"
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


%%



====Categories====
CategoryUserContributions