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.