| 
    
     |  | >例えば「このペンは赤ペンです」という文章がはいったテキストボックスで >「このペンは」は「MS Pゴシック」「黒色の文字」
 >「赤ペン」は「MS P明朝」「赤い文字」「太字」
 >「です」は「MS Pゴシック」「青色の文字」
 >というように、文字一つひとつに異なるフォントを設定しているとします。
 
 示されたコードですが冗長すぎると思います。
 書式を消すことなく置換すればいいでしょう。
 あくまで一例です。詳細仕様はつめてください。
 
 Sub CharacterInput()
 Dim BeforeStr$, AfterStr$
 '  BeforeStr = InputBox("置換前の文字列を入力してください。")
 '  AfterStr = InputBox("置換後の文字列を入力してください。")
 BeforeStr = "赤ペン": AfterStr = "私の物"
 If Len(AfterStr) = 0 Or Len(BeforeStr) = 0 Then Exit Sub
 CharacterSubstitution BeforeStr, AfterStr
 End Sub
 
 Sub CharacterSubstitution(ByVal BeforeStr$, ByVal AfterStr$)
 Dim ws, tb, bInStr&, dif&
 dif = Len(AfterStr) - Len(BeforeStr) 'ins
 For Each ws In Worksheets
 For Each tb In ws.TextBoxes
 bInStr = InStr(tb.Characters.Text, BeforeStr)
 If bInStr Then
 If dif > 0 Then tb.Characters(bInStr + 1, 1).Insert String(dif + 1, "*")
 If dif < 0 Then tb.Characters(bInStr + 1, Abs(dif)).Delete
 tb.Characters(bInStr, Len(AfterStr)).Text = AfterStr
 End If
 Next
 Next
 End Sub
 
 |  |