How to convert multiple strings in a Word document into italics

Asked 2 years ago, Updated 2 years ago, 115 views

We are looking for a way to convert multiple strings in a Word document into italics.
For example, in a word document

String 1
String 2
String 1
String 3
・
・
・

In certain cases, if only string 1 can be converted with WordVBA code below, but I would like to write a code that can be converted into italics even if it is multiple words (like string 2 and string 3).
I would appreciate it if you could tell me how to do it.
Thank you for your cooperation.

SubfindText()

With Selection.Find
    .Text="String 1"
    Do While.Execute
        Selection.Font.Italic=True
    Loop
End With

End Sub

vba ms-word

2022-09-30 14:51

2 Answers

Dear cubik♦ and Kunif, thank you for your comment.
It was my first time at VBA and I completely ignored the question, but after studying a little, I was able to solve it as follows.

We created a record of the string we wanted to make italic in csv, and went through three steps: browsing the csv file on the VBA, checking for matches, and replacing italic.

In addition, the contents of list.csv are marked with string 1 , string 2 , and string 3 in the first column.There may be a little more ways to do it, but I have achieved my goal once.

Sub-Italics Conversion()

    US>'Open the referenced csv file
    Open "list.csv" For Input As #1
    While Not EOF(1)
    Line Input #1,a
    s = Split(a, ", ")
    MsgBox(0)&"&s(0)
    'Declare the variable Target you want to convert to italic
    Dim Target As String
    
    US>'Select the beginning of the document
    ActiveDocument.Range(0,0).Select
    
    'Specify first column of csv file for Target
    Target=s(0)
    
    US>'Clear conditions
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    
    'Italics setting
    Selection.Find.Replacement.Font.Italic=True
    
    US>'Perform italics conversion
With Selection.Find
    .Text=Target
    .Replacement.Text=""
    .Forward=True
    .Wrap=wdFindStop
    .MatchCase=True
    .Execute Replace: =wdReplaceAll
  End With
Selection.Find.ExecuteReplace: =wdReplaceAll
Wend
Close #1
End Sub


2022-09-30 14:51

The following sample code can also be used.

The findArray function looping on an array and findRegexp looping on a regular expression match.
Both change the specified string in the range being selected by the cursor to italics.

The way of thinking itself is as stated in the comments, but I wondered if it could be realized simply by looping, but there was a point that I stumbled unexpectedly.
I mentioned the points in the comments in the sample code.

sample code

'Multiple Loops
SubfindArray()
    'Defining search targets
    Dimwords(3) As String
    words(0) = "String 1" 
    words(1) = "String 2" 
    words(2) = "String 3" 

    DimselRange As Range
    For Each Inwords
        Set selRange=Selection.Range.Duplicate 'Duplicate the selection range at the start of the loop *Otherwise, the selection range will be cleared and you will not be able to select string 2 or later.
        selRange.Find.Text=w
        Do While selRange.Find.Execute
            IfselRange.InRange(Selection.Range) Then 'Target only before the end of the selection *If this If statement is not present, continue processing to the back of the cursor selection range
                selRange.Italic=True
            End If
        Loop
    Next
End Sub

'Regular expression
SubfindRegexp()
    'Prebinding: Microsoft VBScript Regular Expressions
    'Dimre As New RegExp
    'Delay binding
    Dimre As Object
    Set = CreateObject ("VBScript.RegExp")

    re.Pattern = "String 1 | String 2 | String 3" 
    re.Global=True'Get all matches *Only one character can be used without *

    Dim start As Integer
    For Each In. Execute (Selection)
        start = Selection.start + m.FirstIndex 'Select Start Position + Relative Position Hit within Select Range
        Range(start, start+m.Length).Italic=True
    Next
End Sub


2022-09-30 14:51

If you have any answers or tips


© 2024 OneMinuteCode. All rights reserved.