Import Ms Word -Text Into Wikidot

Posted by Helmut_pdorf on 12 Sep 2011 16:20, last edited by Helmut_pdorf on 13 Sep 2011 12:04

Tags: import macro vba word

Original Macro written by Peter Jongsma - see here
Original Page text written for MS 2010 by tsangk - on his site: here

MS Office 2003 (!!)

( MS Office 2007 will follow on the german community wiki )

1. Open Your Word 2003 Document you want to transfer

2. Go to the Tools tab - pull down to "Macro"and click on "Macros" ( Alt+F8)

2. Enter Word2Wiki as the Macro name and click Create.

2.1 Ensure that your current document is selected

3. VB Editor will pop-up:

4. Copy and paste the entire VB Code provided below and close the VB Editor

5. Right-click the blue ribbon and select "Visual Basic" for Menu-Button

6 You have now a "Run Macro" Button Click on it!

7 Select Macro "Word2Wiki" - Click on RUN

8. Your Word Doc is converted into Wikidot Syntax and stored in the Copy buffer

Input:

Output:

9. Create the Wikidot-page to Paste your converted text into

10. Save Your Wikidot.page! You now have a Word to Wikidot converted.

The VB Code:

Click to reveal VB

Option Explicit

Sub Word2Wiki()

    Application.ScreenUpdating = False

    'Heading 1 to Heading 5
    ConvertParagraphStyle wdStyleHeading1, "+ ", ""
    ConvertParagraphStyle wdStyleHeading2, "++ ", ""
    ConvertParagraphStyle wdStyleHeading3, "+++ ", ""
    ConvertParagraphStyle wdStyleHeading4, "++++ ", ""
    ConvertParagraphStyle wdStyleHeading5, "+++++ ", ""

    ConvertItalic
    ConvertBold
    ConvertUnderline
    ConvertImages

    ConvertLists
    ConvertTables

    ' Copy to clipboard
    ActiveDocument.Content.Copy

    Application.ScreenUpdating = True
End Sub

Private Sub ConvertParagraphStyle(styleToReplace As WdBuiltinStyle, _
                                    preText As String, _
                                    postText As String)
    Dim normalStyle As Style
    Set normalStyle = ActiveDocument.Styles(wdStyleNormal)

    ActiveDocument.Select

    With Selection.Find

        .ClearFormatting
        .Style = ActiveDocument.Styles(styleToReplace)
        .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 preText
                    .InsertAfter postText
                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
              .Font.Bold = False
                    .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

                .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
                    .Font.Italic = False
                    .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

                .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
                    .Font.Underline = False
                    .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

                .Font.Underline = False
            End With
        Loop
    End With
End Sub
Private Sub ConvertImages()
    ActiveDocument.Select

    With Selection.Find
        .ClearFormatting
        .Text = "^g"
        .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
                    .Font.Underline = False
                    .Collapse
                    .MoveEndUntil vbCr
                End If

                ' Don't bother to markup newline characters (prevents a loop, as well)
                If Not .Text = vbCr Then
                    .Text = "[[image NEW]]"
                End If
            End With
        Loop
    End With
End Sub

Private Sub ConvertLists()
   Dim para As Paragraph
   Dim i As Long
    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

Private Sub ConvertTables()

    Dim myRange As Word.Range
    Dim tTable  As Word.Table
    Dim tRow    As Word.Row
    Dim tCell   As Word.Cell
    Dim strText As String

    Dim i   As Long
    Dim j   As Long
    Dim k   As Long
    Dim l   As Long

    For Each tTable In ActiveDocument.Tables

            'Memorize table text
            ReDim x(1 To tTable.Rows.Count, 1 To tTable.Columns.Count)
            i = 0
            For Each tRow In tTable.Rows
                i = i + 1
                j = 0
                For Each tCell In tRow.Cells
                    j = j + 1
                    strText = tCell.Range.Text
                    x(i, j) = Left(strText, Len(strText) - 2)
                Next tCell
            Next tRow

            'Delete table and position after table
            Set myRange = tTable.Range
            myRange.Collapse Direction:=wdCollapseEnd
            tTable.Delete

            'Rewrite table with memorized text
            myRange.InsertParagraphAfter
            'myRange.InsertAfter ("S|")
            'myRange.InsertParagraphAfter
            For k = 1 To i
                For l = 1 To j
                    myRange.InsertAfter "||" + x(k, l)
                   ' myRange.InsertAfter " |" + x(k, l)
                Next l
                'myRange.InsertParagraphAfter
                myRange.InsertAfter "||"
                myRange.InsertParagraphAfter
            Next k
            'myRange.InsertAfter ("|E")
            'myRange.InsertParagraphAfter

    Next tTable

End Sub

---

Related articles

• Convert MediaWiki syntax to Wikidot
• Import Simple Excel Tables Into Wikidot
• Create Multiple Word Tags

Comments

See new MS WORD Macro

Helmut_pdorf 19 Apr 2013 19:01

See also new macro on http://community.wikidot.com/forum/t-10433/comments/show#post-1756048

---

Service is my success. My webtips:www.blender.org (Open source), Wikidot-Handbook.

Sie können fragen und mitwirken in der deutschsprachigen » User-Gemeinschaft für WikidotNutzer oder
im deutschen » Wikidot Handbuch ?