Italicize word to the left, but set continued typing not in italics

Question

I've been working with ChatGPT to italicizes word to the left of cursor, but it sets continued typing not in italics in Word 2019. But after an hour, all we've been able to do is the following:

Sub ItalicizeWordToLeft()
    On Error Resume Next ' Ignore errors temporarily

    Dim autoFormatStatus As Boolean
    Dim currentCursorPosition As Integer

    ' Store the current auto-format setting
    autoFormatStatus = Application.Options.AutoFormatAsYouTypeReplaceHyperlinks

    ' Temporarily disable auto-formatting changes
    Application.Options.AutoFormatAsYouTypeReplaceHyperlinks = False

    ' Store the current cursor position
    currentCursorPosition = Selection.Start

    ' Italicize the word to the left of the cursor
    Selection.MoveLeft Unit:=wdWord, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Font.Italic = True

    ' Move the cursor to the end of the italicized word
    Selection.EndOf Unit:=wdWord, Extend:=wdMove

    ' Enable auto-formatting changes back to the original status
    Application.Options.AutoFormatAsYouTypeReplaceHyperlinks = autoFormatStatus

    On Error GoTo 0 ' Reset error handling to default
End Sub

This italics the word to the left, leaves the cursor at the end of the word but continued typing is in italics. How do I modify so continued typing is not in italics?

Answer 1

ChatGPT makes it more complicated than it should be.

Option Explicit

Sub ItalicizeWordToLeft()
    Selection.Collapse Word.wdCollapseStart
    Selection.MoveLeft Unit:=wdWord, Count:=1
    Selection.Expand Unit:=wdWord
    If Right(Selection.Range.Text, 1) = " " Then
        Selection.End = Selection.End - 1
    End If
    Selection.Font.Italic = True
    Selection.Collapse Word.wdCollapseEnd
    Selection.Font.Italic = False
    ' Selection.TypeText " Just for testing"
End Sub

Microsoft documentation:

Selection.Collapse method (Word)

Selection.Expand method (Word)

Answer 2

Working for over an hour with ChatGPT, we finally have it working with the following:

Sub ItalicizeWordToLeftAndAddX()
    On Error Resume Next ' Ignore errors temporarily

    ' Store the current auto-format setting
    Dim autoFormatStatus As Boolean
    autoFormatStatus = Application.Options.AutoFormatAsYouTypeReplaceHyperlinks

    ' Temporarily disable auto-formatting changes
    Application.Options.AutoFormatAsYouTypeReplaceHyperlinks = False

    ' Italicize the word to the left of the cursor
    Selection.MoveLeft Unit:=wdWord, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Font.Italic = True

    ' Move to the end of the italicized word
    Selection.MoveRight Unit:=wdWord, Count:=1

    ' Add a space and an "X" at the end
    Selection.TypeText Text:=" X"

    ' Turn Italics to false for the added "X"
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Font.Italic = False

    ' Move back to the end of the italicized word
    Selection.MoveRight Unit:=wdWord, Count:=1

    ' Delete the added "X"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter

    ' Move the cursor back to regular text
    Selection.Font.Italic = False

    ' Enable auto-formatting changes back to the original status
    Application.Options.AutoFormatAsYouTypeReplaceHyperlinks = autoFormatStatus

    On Error GoTo 0 ' Reset error handling to default
End Sub

Could someone let me know if there is an better way to do this?