|
>例えば「このペンは赤ペンです」という文章がはいったテキストボックスで
>「このペンは」は「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
|
|