VBA macro to replace strings in italics with italics style

RobiNew · #1 09-25-2023, 08:54 AM

I'm trying to replace strings in italics with an italics style. This code returns an error and is incomplete:

Quote:

Sub ITALICS()
For Each myRng In ActiveDocument.StoryRanges
Do
With myRng
Do
With .Find

.MatchWildcards = False
.Text = ""
.Replacement.Text = ""
.Font.Italic
.Wrap = wdFindStop
.Execute
End With
If Find.Found Then
MsgBox Selection.Text
'Replace with Style
Else: Exit Do
End If
myRng.Collapse 0
Loop
End With
Set myRng = myRng.NextStoryRange
Loop Until myRng Is Nothing
Next myRng
End Sub

vivka · #2 09-25-2023, 12:41 PM

Hi! Try this:

Code:

Sub ITALICS()
    For Each myRng In ActiveDocument.StoryRanges
        Do
            With myRng
                Do
                    With .Find
                    .MatchWildcards = False
                    .text = ""
                    .Replacement.text = ""
                    .Font.Italic = True
                    .Wrap = wdFindStop
                    .Execute
                    End With
                    If .Find.found Then
                        MsgBox myRng.text
'Replace with Style:
                        myRng.Style = "Italic"
                    Else: Exit Do
                    End If
                    myRng.Collapse 0
                Loop
            End With
            Set myRng = myRng.NextStoryRange
        Loop Until myRng Is Nothing
    Next myRng
End Sub

I am not sure if the Italic style used in the code is built-in or created by me previously. Anyway, you can create your own style to meet all your needs.

Guessed · #3 09-25-2023, 08:13 PM

At its simplest, it is just a simple find and replace that doesn't require special loop handling of the .Found result

Code:

Sub Macro1()
  Dim aRng As Range
  For Each aRng In ActiveDocument.StoryRanges
    With aRng.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = ""
      .Replacement.Text = ""
      .Font.Italic = True
      .Replacement.Style = ActiveDocument.Styles("Emphasis")
      .Forward = True
      .Wrap = wdFindContinue
      .Format = True
      .MatchCase = False
      .MatchWholeWord = False
      .MatchKashida = False
      .MatchDiacritics = False
      .MatchAlefHamza = False
      .MatchControl = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Execute Replace:=wdReplaceAll
    End With
  Next aRng
End Sub

However, there can be real complexity depending on what you are searching for. For instance, if there is content with a paragraph style including the Italic then the doubling up with a character style will remove the italics. This is because the Italics is a toggle setting and if italic is turned on twice (first by paragraph style and then by character style) then you have toggled it on, then off again.
Also, applying a character style to text which has multiple local font attributes (eg italic AND bold AND a different colour) will remove the 'other attributes' when the character style is applied.

RobiNew · #4 09-26-2023, 12:21 AM

Hi, Vivka and Guessed! Thanks a lot to both of you! I now see all the implications of applying a character style. However, my problem now is that the two codes alter headings and footers, but I want the change only in the text and the footnotes. How should I modify the code? Thanks!

Guessed · #5 09-26-2023, 09:09 PM

Try this

Code:

Sub Macro1()
  Dim aRng As Range, iType As Integer
  On Error GoTo EndSub    'footnotes story may not exist in all docs
  For iType = 1 To 2
    Set aRng = ActiveDocument.StoryRanges(iType)   'wdMainTextStory = 1, wdFootnotesStory = 2
    With aRng.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = ""
      .Replacement.Text = ""
      .Font.Italic = True
      .Replacement.Style = ActiveDocument.Styles("Emphasis")
      .Forward = True
      .Wrap = wdFindContinue
      .Format = True
      .MatchCase = False
      .MatchWholeWord = False
      .MatchKashida = False
      .MatchDiacritics = False
      .MatchAlefHamza = False
      .MatchControl = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Execute Replace:=wdReplaceAll
    End With
  Next iType
EndSub:
End Sub

RobiNew · #6 09-26-2023, 11:19 PM

It's perfect. Many thanks, also for the comments!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
italics for another language	mga	Word	1	04-16-2018 03:58 AM
How can I find paragraphs all in italics?	Robert2	Word	1	01-28-2014 02:54 PM
Font style keeps changing to Italics	B33J	Word	1	07-24-2013 01:46 PM
How to retain italics when pasting from PDF?	WaltR	Word	0	03-01-2011 04:01 PM
Spellcheking, grammar and italics	Rosseiro	Word	0	08-20-2010 10:07 PM