Consulting

Results 1 to 10 of 10

Thread: duplicate specific text and underline it

  1. #1

    Exclamation duplicate specific text and underline it

    Hello All,


    i have a huge number of files need to be translated with specific instructions


    the most complicated case which i face is to duplicate all turquoise highlighted text and make the duplicated one's first character to be underlined


    and the original one to be hidden as shown below


    Before


    1.png


    After


    2.png

    i have attached a sample file for such a case

    Thanks in advance for any hint or tips

    Cheers


    Cross Posted link: Here
    Attached Files Attached Files

  2. #2
    I guess something like

    Sub Macro1()'Graham Mayor - https://www.gmayor.com - Last updated - 29 May 2019
    Dim oRng As Range
    Dim i As Integer
        Set oRng = ActiveDocument.Range
        With oRng.Find
            .Highlight = True
            Do While .Execute
                oRng.Font.Underline = wdUnderlineNone
                oRng.NoProofing = True
                i = Len(oRng)
                oRng.InsertAfter oRng.Text
                oRng.MoveEnd Count:=i
                oRng.Characters(i + 1).Underline = wdUnderlineSingle
                For i = i To 1 Step -1
                    oRng.Characters(i).Font.Hidden = True
                Next i
                oRng.Collapse 0
            Loop
        End With
    lbl_Exit:
        Set oRng = Nothing
        Exit Sub
    End Sub
    should work
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Hello Graham,

    really i don't have enough words to thank you. you save my day

    just one more thing to help if possible, as you see below it is supposed to be a space here

    3.jpg



    your support is always appreciated

  4. #4
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    You might try this adaptation of Graham's original code.

    Sub Macro1() 
    Dim oRng As Range
    Dim oRng2 As Range
    Dim i As Long
    
      Set oRng = ActiveDocument.Range
      With oRng.Find
        .Highlight = True
        Do While .Execute
          oRng.Font.Underline = wdUnderlineNone
          oRng.NoProofing = True
          i = Len(oRng)
          Set oRng2 = oRng.Duplicate
          oRng2.InsertAfter " " & oRng.Text
          oRng2.Characters(i + 2).Underline = wdUnderlineSingle
          oRng.Font.Hidden = True
          oRng.Start = oRng2.End
          oRng.End = ActiveDocument.Range.End
        Loop
      End With
    lbl_Exit:
      Set oRng = Nothing
      Exit Sub
    End Sub
    Greg

    Visit my website: http://gregmaxey.com

  5. #5
    Hi Greg,

    Your code works great but if i used it on more than one page it crashes!!

    i think this is because the huge number of terms that need to be duplicated, i tried it on a file contains about 1000 terms

    or is it about the the (Loop) in the code?!

    Cheers

  6. #6
    Add the line
    DoEvents
    immediately before the line
    Loop
    This will prevent the bottleneck
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    Hi Graham,

    i'm really appreciate your support but unfortunately it still crashing !!

    i have attached a sample file from one page only that failed to run the code on
    Attached Files Attached Files

  8. #8
    i think there is issue about the table?!!

    when i convert the table to text or delete the tables it works very well
    Last edited by Ethen5155; 05-30-2019 at 05:25 AM.

  9. #9
    Use the following variation of my original code which I think does what you now want, and doesn't crash in your table.
    Sub Macro1() 
    'Graham Mayor - https://www.gmayor.com - Last updated - 31 May 2019
    Dim oRng As Range
    Dim i As Integer
        Set oRng = ActiveDocument.Range
        With oRng.Find
            .Highlight = True
            Do While .Execute
                oRng.Font.Underline = wdUnderlineNone
                oRng.NoProofing = True
                i = Len(oRng)
                oRng.InsertAfter Chr(32) & oRng.Text
                oRng.MoveEnd Count:=i + 1
                oRng.Characters(i + 2).Underline = wdUnderlineSingle
                For i = i To 1 Step -1
                    oRng.Characters(i).Font.Hidden = True
                Next i
                oRng.Collapse 0
                DoEvents
            Loop
        End With
    lbl_Exit:
        Set oRng = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  10. #10
    Hi Graham ,

    you are my savior

    it works like magic now, your support is highly appreciated

    Cheers

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •