How to duplicate paragraphs & format them

effimera · #1 12-11-2021, 08:54 AM

Hello there,

I am wondering if someone could help me with a similar task of duplicating paragraphs (except in tables, not in textboxes either) by using VBA.

I tried to record a macro that duplicates source paragraphs underneath and italicizes the duplicated ones at the same time, but it doesn't work properly.
I recorded it with 3 paragraphs, but this is the problem -- if I run the macro on larger text (i.e. with more than three paragraphs), it does so on the first three only, and the rest remains unduplicated.
So, does anybody know how to refine it in order to duplicate and italicize an unlimited number of paragraphs. And please with no locking, as I would often need to select and hide or format them for CAT translation.

Here it is:

Code:

  Sub DuplicateAndItalicizeParagraph()
  '
  ' DuplicateAndItalicizeParagraph Makro
  '
  '
      Selection.HomeKey Unit:=wdStory
      Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
      Selection.Copy
      Selection.MoveRight Unit:=wdCharacter, Count:=1
      Selection.TypeParagraph
      Selection.MoveUp Unit:=wdLine, Count:=1
      Selection.PasteAndFormat (wdFormatOriginalFormatting)
      Selection.MoveLeft Unit:=wdCharacter, Count:=1
      Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
      Selection.Font.Italic = wdToggle
      Selection.MoveRight Unit:=wdCharacter, Count:=3
      Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
      Selection.Copy
      Selection.MoveRight Unit:=wdCharacter, Count:=1
      Selection.TypeParagraph
      Selection.MoveUp Unit:=wdLine, Count:=1
      Selection.PasteAndFormat (wdFormatOriginalFormatting)
      Selection.MoveLeft Unit:=wdCharacter, Count:=1
      Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
      Selection.Font.Italic = wdToggle
      Selection.MoveRight Unit:=wdCharacter, Count:=3
      Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
      Selection.Copy
      Selection.MoveRight Unit:=wdCharacter, Count:=1
      Selection.TypeParagraph
      Selection.PasteAndFormat (wdFormatOriginalFormatting)
      Selection.MoveLeft Unit:=wdCharacter, Count:=1
      Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
      Selection.Font.Italic = wdToggle
      Selection.MoveRight Unit:=wdCharacter, Count:=1
  End Sub

Thank you in advance.

gmayor · #2 12-16-2021, 09:57 PM

Without the document to test, the following should work

Code:

Sub Macro1()
Dim oRng As Range
Dim oPara As Range, oNewPara As Range
Dim i As Long
    Set oRng = Selection.Range
    If oRng.End = ActiveDocument.Range.End Then
        oRng.InsertParagraphAfter
    End If
    For i = oRng.Paragraphs.Count To 1 Step -1
        Set oPara = oRng.Paragraphs(i).Range
        Set oNewPara = oPara.Duplicate
        oNewPara.Collapse 0
        oNewPara.FormattedText = oPara.FormattedText
        oNewPara.Font.Italic = True
    Next i
lbl_Exit:
    Set oRng = Nothing
    Set oPara = Nothing
    Set oNewPara = Nothing
    Exit Sub
End Sub

effimera · #3 12-20-2021, 04:40 AM

Quote:

Originally Posted by gmayor

Without the document to test, the following should work

Code:

Sub Macro1()
Dim oRng As Range
Dim oPara As Range, oNewPara As Range
Dim i As Long
    Set oRng = Selection.Range
    If oRng.End = ActiveDocument.Range.End Then
        oRng.InsertParagraphAfter
    End If
    For i = oRng.Paragraphs.Count To 1 Step -1
        Set oPara = oRng.Paragraphs(i).Range
        Set oNewPara = oPara.Duplicate
        oNewPara.Collapse 0
        oNewPara.FormattedText = oPara.FormattedText
        oNewPara.Font.Italic = True
    Next i
lbl_Exit:
    Set oRng = Nothing
    Set oPara = Nothing
    Set oNewPara = Nothing
    Exit Sub
End Sub

Thank you, gmayor!
It works perfectly - much obliged

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Duplicate paragraphs except in tables	jalve	Word VBA	21	05-26-2021 07:38 PM
Format multiple paragraphs differently	Dave T	Word VBA	7	07-31-2019 08:12 PM
delete 1 or 2 adjacent duplicate paragraphs, macro	moorea21	Word	4	11-01-2018 12:53 PM
How to find duplicate phrases/paragraphs in a long document	iamgator	Word VBA	5	12-27-2016 01:34 AM
VBA to set format for paragraphs that meet with specific requirements	AustinBrister	Word VBA	3	06-01-2015 07:00 AM