Microsoft Office Forums - View Single Post - [Solved] How to duplicate paragraphs & format them

effimera · 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.