Revision [12158]

This is an old revision of WinWord2WikkaWikiAction made by NickDamoulakis on 2005-12-07 14:32:47.

 

WinWord2WikkaWikiAction


Credits

Macro to convert WinWord docs to WikkaWiki markup.

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




Code


Sub Word2Wiki()
    Application.ScreenUpdating = False
    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




Categories

CategoryUserContributions
There are no comments on this page.
Valid XHTML :: Valid CSS: :: Powered by WikkaWiki