VBA ExcelでWordのテキストボックス内の文字列に取り消し線を表示させる

Sub EXCEL_WORD02() 'EXCEL VBAから既存のWORDファイルを起動する。
 
    Dim WordApp As Object
    Dim WordDoc As Word.Document
                            '
    Set WordApp = CreateObject("Word.Application") ' CreateObject関数でWordをセット
 
    WordApp.Visible = True 'Wordを起動する
  
    Set WordDoc = WordApp.Documents.Open("C:\Users\sannp\OneDrive\デスクトップ\test01.docx") ' 指定したWordファイルを起動します。
 
    Dim srcText As String
    srcText = "なおき"
     
    Dim shp As Object  ' Word.Shape
 
    For Each shp In WordApp.ActiveDocument.Shapes
        If shp.Type = msoTextBox Then
            Call DoubleStrikeText(shp, srcText)

        End If
    Next
    
End Sub

 

Public Sub DoubleStrikeText(shp As Variant, srcText As String)
    
    If shp.TextFrame.HasText Then
        Dim objFind As Find
        Set objFind = shp.TextFrame.TextRange.Find
        
        objFind.ClearFormatting
        objFind.Forward = True
        objFind.Text = srcText
        objFind.Replacement.Font.DoubleStrikeThrough = True
        Call objFind.Execute(Replace:=wdReplaceAll)
        
    End If
End Sub