#1
|
|||
|
|||
Merge paragraphs to one
I found code, which should join text to one paragraph (which helpfull when copy paste from htm, pdf etc). But it doesn't work. For later versions of MS Word?
Sub CleanUpPastedText() Dim xSelection As Selection On Error Resume Next Application.ScreenUpdating = False Set xSelection = Application.Selection If xSelection.Type <> wdSelectionIP Then FindAndReplace xSelection Else If MsgBox("Do you want to merge all selected lines into one paragraph?", vbYesNo + vbInformation, "Kutools for Word") = vbNo Then Exit Sub xSelection.WholeStory Set xSelection = Application.Selection xSelection.HomeKey wdStory FindAndReplace xSelection End If Application.ScreenUpdating = True Application.ScreenRefresh MsgBox "The selected lines have been merged into one paragraph.", vbInformation, "Kutools for Word" End Sub Sub FindAndReplace(Sel As Selection) With Sel.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .Format = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Text = "[^s^t]{1,}^13" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "([!^13])([^13])([!^13])" .Replacement.Text = "\1\3" .Execute Replace:=wdReplaceAll .Text = "[ ]{2,}" .Replacement.Text = " " .Execute Replace:=wdReplaceAll .Text = "([a-z])-[ ]{1,}([a-z])" .Replacement.Text = "\1\2" .Execute Replace:=wdReplaceAll .Text = "[^13]{1,}" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll End With End Sub Also doesn't work othe code, which i found: Sub CleanUpPastedText() 'Turn Off Screen Updating Application.ScreenUpdating = False With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .Format = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True 'Eliminate spaces & tabs before paragraph breaks. .Text = "[ ^s^t]{1,}^13" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll 'Replace single paragraph breaks & line breaks with a space .Text = "([!^13^l])([^13^l])([!^13^l])" .Replacement.Text = "\1 \3" 'Replace all double spaces with single spaces .Execute Replace:=wdReplaceAll .Text = "[^s ]{2,}" .Replacement.Text = " " 'Delete hypens in hyphenated text formerly split across lines .Execute Replace:=wdReplaceAll .Text = "([a-z])-[ ]{1,}([a-z])" .Replacement.Text = "\1\2" .Execute Replace:=wdReplaceAll 'Limit paragraph breaks & line breaks to one paragraph break per 'real' paragraph. .Text = "[^13^l]{1,}" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll End With 'Restore Screen Updating Application.ScreenUpdating = True End Sub The best way for me is just: Sub JoinLines() With Selection.Find .Text = "^p" .Replacement.Text = " " .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Exit Sub End Sub ? |
#2
|
||||
|
||||
Often when you are pasting in content from html sources you end up with a lot of tabular text which is more than just a paragraph mark between the paragraphs. The code you have shown won't merge content in table cells or floating text boxes. Also some of the code only works on selected text - which presupposes you have actually selected the text before running that code.
Obviously, we can't see what content you are actually trying to run this code on. Perhaps it would be clearer if you attached a document that contains the sort of content you want the code to work on.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
select paragraphs | yacov | Word | 2 | 10-25-2020 02:53 AM |
correcting all the paragraphs | kiv | Word | 5 | 09-17-2015 02:43 AM |
Grouping paragraphs | h.ridinger | Word | 2 | 11-06-2013 10:42 AM |
Space between paragraphs... | Emerogork | Outlook | 2 | 06-24-2011 10:23 AM |
finding paragraphs | sixhobbits | Word | 2 | 06-14-2010 09:48 AM |