• View
• Edit
• History
• Attach
• Print
• Backlinks

WordPaste

Questions answered by this recipe

Is it possible to automatically format text pasted from MS Word? I have a lot of word documents I want to put into my wiki pages, but the formatting takes forever.

Description

Just as there is an ExcelPaste cookbook recipe, the same should go for Microsoft word. Other Wikis such as usemod and wikimedia have this functionality to speed along formatting.

Notes

See the wikimedia macro Word2Wiki and also the usemod wiki enhancement WordToWiki.

Release Notes

Contributors

Mike Smick

WordMacro for PmWiki

'from http://www.usemod.com/cgi-bin/wiki.pl?WordToWiki/Source_Code
'Edit for PmWiki by Kent Berggren
'NOTE: A newline character bolded all by itself (no bold text before or after) will cause an infinite loop in this. Presumably the same for italics & underline? Peter Bowers

Sub WordToPmWiki()

    Application.ScreenUpdating = False

    ConvertH1
    ConvertH2
    ConvertH3

    ConvertItalic
    ConvertBold
    ConvertUnderline

    ConvertLists

    ConvertCarriageReturns

    ConvertTables

    ' Copy to clipboard
    ActiveDocument.Content.Copy

    Application.ScreenUpdating = True

End Sub

Private Sub ConvertCarriageReturns()

    ActiveDocument.Content.Find.ClearFormatting
    ActiveDocument.Content.Find.Execute FindText:="^p", ReplaceWith:="^p^p", Format:=True, Replace:=wdReplaceAll, MatchControl:=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
                    ' 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 = 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
                    ' 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 = 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
                    ' 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 = 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
                    .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
                    .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
                    .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 ConvertLists()

    Dim para As Paragraph
    For Each para In ActiveDocument.ListParagraphs
        With para.Range
            If .ListFormat.ListType = wdListBullet Then
                .InsertBefore "*"
            Else
                .InsertBefore "#"
            End If

            .ListFormat.RemoveNumbers
        End With
    Next para

End Sub

Private Sub ConvertTables()

    Dim thisTable As Table
    Dim thisRow As Row
    Dim thisCell As Cell
    For Each thisTable In ActiveDocument.Tables
            For Each thisRow In thisTable.Rows
                For Each thisCell In thisRow.Cells
                    thisCell.Range.InsertBefore "||"
                    thisCell.Range.Find.Execute FindText:="^p", ReplaceWith:=" ", Format:=True, Replace:=wdReplaceAll, MatchControl:=True
                Next thisCell
                    thisRow.Range.InsertAfter "||"
            Next thisRow
            thisTable.ConvertToText Separator:=" "
    Next thisTable

End Sub

See Also

• Word2PmWiki for another macro doing the same type of thing
• ConvertHTML might be another alternative, saving to HTML and then converting HTML -> PmWiki