Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 07-03-2022, 09:25 PM
baidu0021 baidu0021 is offline Need help with word macro to duplicate paragraphs in word document Mac OS X Need help with word macro to duplicate paragraphs in word document Office 2021
Novice
Need help with word macro to duplicate paragraphs in word document
 
Join Date: Jul 2022
Posts: 3
baidu0021 is on a distinguished road
Default Need help with word macro to duplicate paragraphs in word document


I need a macro to duplicate paragraph (with same format and style) and insert it below the original paragraph. I have issue when the paragraph is in a table cell (it will not go to next paragraph in the cell) or when a paragraph is located before a table (paragraph will insert into the table). Thank you!

Code:
Sub CopyPara()
    
    Dim testRng, oRng, newRng As Range
    Dim beforeTable, EOD As Boolean
    'end of cell char
    EOC = Chr(13) & Chr(7)
    
    EOD = False
    beforeTable = False
    'move selection to begining of the doc
    Selection.HomeKey Unit:=wdStory
    
    Do Until Selection.End = ActiveDocument.Range.End
        If counter > 0 Then
            Selection.MoveDown Unit:=wdParagraph, Count:=1
        Else
            Set oRng = Selection.Paragraphs(1).Range
        End If
        'select the first para
        Selection.Paragraphs(1).Range.Select
        
        Set oRng = Selection.Paragraphs(1).Range
      
        Set testRng = Selection.Next(Unit:=wdParagraph, Count:=1)

        'test if next para is in a table
        If Not testRng Is Nothing Then
            If testRng.Information(wdWithInTable) Then beforeTable = True
        End If
        'if it is last para oof the doc, exit loop
        If oRng.End = ActiveDocument.Range.End Then
            EOD = True
            MsgBox ("EOC = " & EOD)
            Exit Do
        End If
        
        'count the characters
        char_count = Len(Trim(Selection.Paragraphs(1).Range))
        
        'check if empty para
        If char_count > 2 Then
            
            If oRng.Text Like "*" & EOC Or EOD Or beforeTable Then 'check if selection reach end of cell
                EOCCopyPaste (oRng)  'Do the EOC copy and paste
                beforeTable = False
            Else
                NormalCopyPaste (oRng) 'Do the nomal copy and paste
            End If
        End If
       
        'move selection to new paragraph
        Selection.Move Unit:=wdParagraph, Count:=1
       
   
    Loop
    
End Sub

Function NormalCopyPaste(ByVal Rng As Range)
Dim newRng As Range
                Set newRng = Rng.Duplicate
                'move the selection to the front of new range
                newRng.Collapse Direction:=wdCollapseEnd
                newRng.FormattedText = Rng.FormattedText
                Rng.Font.Hidden = True
                newRng.Font.Color = wdColorBlue
                'move selection to end of new range
                Selection.End = newRng.End
                
End Function
Function EOCCopyPaste(ByVal Rng As Range)
Dim newRng As Range
                'exclude the EOC character
                Rng.End = Rng.End - 1
                'Debug.Print Rng.Text
                'insert a para
                Rng.InsertParagraphAfter
                'duplicate the range
                Set newRng = Rng.Duplicate
                'move the selection to the front of new range
                newRng.Collapse Direction:=wdCollapseEnd
                'paste the new range
                newRng.FormattedText = Rng.FormattedText
                'change color
                newRng.Font.Color = wdColorGreen
                '
                'newRng.Next.Delete
                'remove the para mark
                'newRng.Text = Replace(newRng.Text, vbCr, "")
                'set the old range to hidden
                Rng.Font.Hidden = True
                'move the selection to the end of new range
                Selection.End = newRng.End
              
End Function
Attached Files
File Type: docx test doc.docx (22.7 KB, 10 views)
File Type: docx Expected result.docx (20.5 KB, 8 views)

Last edited by baidu0021; 07-04-2022 at 02:58 AM. Reason: update to Sub CopyPara
Reply With Quote
  #2  
Old 07-04-2022, 10:20 PM
Guessed's Avatar
Guessed Guessed is online now Need help with word macro to duplicate paragraphs in word document Windows 10 Need help with word macro to duplicate paragraphs in word document Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,057
Guessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud of
Default

Try this macro
Code:
Sub TranslationPrep()
  Dim iPar As Double, aRng As Range, aPar As Paragraph
  Dim iCount As Double, aRngAdd As Range, iExtra As Integer
  With ActiveDocument
    For iPar = .Paragraphs.Count To 1 Step -1
      Set aPar = .Paragraphs(iPar)
      Set aRng = aPar.Range
      If Len(aRng) > 2 Then
        Set aRngAdd = .Range(aRng.Start, aRng.Start)
        iExtra = Len(aRng.Text) - Len(Split(aRng.Text, vbCr)(0))
        If iExtra > 1 Then
          aRng.End = aRng.End - iExtra
          aRngAdd.FormattedText = aRng.FormattedText
          aRngAdd.InsertParagraphAfter
        Else
          aRngAdd.FormattedText = aRng.FormattedText
        End If
        aRngAdd.Font.Hidden = True
        With aRng.Paragraphs.Last.Range
          .Font.ColorIndex = wdBlue
          .ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
        End With
      End If
    Next iPar
  End With
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #3  
Old 07-05-2022, 12:44 AM
baidu0021 baidu0021 is offline Need help with word macro to duplicate paragraphs in word document Mac OS X Need help with word macro to duplicate paragraphs in word document Office 2021
Novice
Need help with word macro to duplicate paragraphs in word document
 
Join Date: Jul 2022
Posts: 3
baidu0021 is on a distinguished road
Default

This works perfectly! Thank you.
Reply With Quote
  #4  
Old 07-06-2022, 12:22 AM
baidu0021 baidu0021 is offline Need help with word macro to duplicate paragraphs in word document Mac OS X Need help with word macro to duplicate paragraphs in word document Office 2021
Novice
Need help with word macro to duplicate paragraphs in word document
 
Join Date: Jul 2022
Posts: 3
baidu0021 is on a distinguished road
Default

Hi Andrew,
I just found out there are issues:
1. the last character of a paragraph in a table cell was removed if the para does not end with paragraph mark.
2. When the last part of the the paragraph text is a hyperlink, the macro hit runtime error " Cannot edit Range" and debug stops at "aRngAdd.InsertParagraphAfter"

please try the code on new test doc to replicate the issue.
Thank you.
Attached Files
File Type: docx test doc.docx (18.4 KB, 6 views)
Reply With Quote
  #5  
Old 07-06-2022, 04:58 AM
Guessed's Avatar
Guessed Guessed is online now Need help with word macro to duplicate paragraphs in word document Windows 10 Need help with word macro to duplicate paragraphs in word document Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,057
Guessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud of
Default

OK, this version doesn't have that issue but won't retain other formatting into the duplicate.
Code:
Sub TranslationPrep()
  Dim iPar As Double, aRng As Range, aPar As Paragraph
  Dim iCount As Double, aRngAdd As Range, iExtra As Integer
  Dim sPar As String
  With ActiveDocument
    For iPar = .Paragraphs.Count To 1 Step -1
      Set aPar = .Paragraphs(iPar)
      Set aRng = aPar.Range
      If Len(Trim(aRng.Text)) > 2 Then
        Set aRngAdd = .Range(aRng.Start, aRng.Start)
        sPar = Trim(Split(aRng.Text, vbCr)(0))
        aRngAdd.Text = sPar & vbCr
        aRngAdd.Font.Hidden = True
        With aRng.Paragraphs.Last.Range
          .Font.ColorIndex = wdBlue
          .ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
        End With
      End If
    Next iPar
  End With
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
[Word VBA macro] How to open the website [languagetool.org] and check my Word document? citroen Word VBA 0 10-25-2020 05:07 AM
ms word document text translation using vba code pk_00 Word VBA 1 03-02-2020 03:11 PM
Macro to extract bookmarked data from Word document and insert into another Word Document VStebler Word VBA 3 05-03-2018 05:02 PM
Macro to transfer data from Word to another Word document with bookmark Jovan Yong Word VBA 3 04-17-2018 04:27 AM
Need help with word macro to duplicate paragraphs in word document Word Macro to publish document as pdf (Word 2010) bville Word VBA 2 04-11-2013 03:30 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 09:48 PM.


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