Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #1  
Old 03-27-2023, 12:14 AM
Dimsok Dimsok is offline Merge paragraphs to one Windows XP Merge paragraphs to one Office 2007
Advanced Beginner
Merge paragraphs to one
 
Join Date: Sep 2014
Location: exUSSR
Posts: 50
Dimsok is on a distinguished road
Default 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

?
Reply With Quote
 



Similar Threads
Thread Thread Starter Forum Replies Last Post
Merge paragraphs to one 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

Other Forums: Access Forums

All times are GMT -7. The time now is 09:14 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft