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
- Doc2Pmwiki for Linux and without formatting
User notes : If you use, used or reviewed this recipe, you can add your name. These statistics appear in the Cookbook listings and will help newcomers browsing through the wiki.