Friday, December 4, 2009

word to wiki convertor macro

Using the Macro :

It is translated to TiddlyWiki from Word2Wiki by RobertCastley: as posted onto WikiMedia's Meta-wiki page. go to http://meta.wikimedia.org/wiki/Word_macros#Word2TWiki for the original and the instructions there.

To use it, you must first load it as a word macro:
    * copy the vba script below into a text editor and then save it as
Word2TiddlyWiki.bas
    * Open your word document and then hit Alt+F11.
    * Then select File -> Import File.
    * Select the file you have just saved.
    * Close the Visual Basic screen.
to run the macro:
    * Block the text you want to convert
    * Then in your Word document select Alt+F8.
    * The converter will do its job and should automatically copy the
conversion into the clipboard.
    * All you then need to do is to paste into your editor in
TiddlyWiki.


Code :--- VBA

Sub Word2TiddlyWiki()

    Application.ScreenUpdating = False

    'Convert Headers
    ConvertH1
    ConvertH2
    ConvertH3
    ConvertH4
    ConvertH5
   
    'Convert fonts
    ConvertItalic
    ConvertBold
    ConvertUnderline

    ' todo: Add ConvertTables

    ' Copy to clipboard
    ActiveDocument.Content.Copy

    Application.ScreenUpdating = 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
                'mark newline
                    .Collapse
                    .MoveEndUntil vbCr
                End If
               
                'don't mark newline
                If Not .Text = vbCr Then
                    .InsertBefore "!"
                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
                'mark newline
                    .Collapse
                    .MoveEndUntil vbCr
                End If

                'don't mark newline

                If Not .Text = vbCr Then
                    .InsertBefore "!!"
                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
                'mark newline
                    .Collapse
                    .MoveEndUntil vbCr
                End If

                'don't mark newline

                If Not .Text = vbCr Then
                    .InsertBefore "!!!"
                End If

                .Style = normalStyle
            End With
        Loop
    End With
End Sub
Private Sub ConvertH4()
    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
                'mark newline
                    .Collapse
                    .MoveEndUntil vbCr
                End If

                'don't mark newline
                If Not .Text = vbCr Then
                    .InsertBefore "!!!!"
                End If

                .Style = normalStyle
            End With
        Loop
    End With
End Sub
Private Sub ConvertH5()
    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
                'mark newline
                    .Collapse
                    .MoveEndUntil vbCr
                End If

                'don't mark newline
                If Not .Text = vbCr Then
                    .InsertBefore "!!!!!"
                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
                'mark newline
                          .Font.Bold = False
                    .Collapse
                    .MoveEndUntil vbCr
                End If

                'don't mark newline
                If Not .Text = vbCr Then
                    .InsertBefore "''"
                    .InsertAfter "''"
                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
                'mark newline
                    .Font.Italic = False
                    .Collapse
                    .MoveEndUntil vbCr
                End If

                'don't mark newline
                If Not .Text = vbCr Then
                    .InsertBefore "//"
                    .InsertAfter "//"
                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
                'mark newline
                    .Font.Underline = False
                    .Collapse
                    .MoveEndUntil vbCr
                End If

                'don't mark newline
                If Not .Text = vbCr Then
                    .InsertBefore "__"
                    .InsertAfter "__"
                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
            .InsertBefore " "
            For i = 1 To .ListFormat.ListLevelNumber
                If .ListFormat.ListType = wdListBullet Then
                    .InsertBefore "*"
                Else
                    .InsertBefore "#"
                End If
            Next i
            .ListFormat.RemoveNumbers
        End With
    Next para
End Sub


No comments: