| |
失礼..
置換内容によっては無限Loopでした...orz
※箇所の修正or追加必要です。
Sub test2()
Dim ws As Worksheet
Dim tb As TextBox
Dim chk As String
Dim rep As String
Dim n As Long
Dim rn As Long '※
Dim p As Long
Dim i As Long '※
Dim x(8)
chk = "うえお"
rep = "こんにちは"
n = Len(chk) - 1
rn = Len(rep) '※
For Each ws In Worksheets
For Each tb In ws.TextBoxes
With tb
i = 1
Do
p = InStr(i, .Text, chk) '※
If p = 0 Then Exit Do
If n > 0 Then
.Characters(p + 1, n).Insert rep
.Characters(p, 1).Delete
Else
With .Characters(p, 1).Font
x(0) = .Name
x(1) = .Size
x(2) = .Bold
x(3) = .Italic
x(4) = .Shadow
x(5) = .FontStyle
x(6) = .ColorIndex
x(7) = .OutlineFont
x(8) = .Strikethrough
End With
.Characters(p, 1).Insert rep
With .Characters(p, Len(rep)).Font
.Name = x(0)
.Size = x(1)
.Bold = x(2)
.Italic = x(3)
.Shadow = x(4)
.FontStyle = x(5)
.ColorIndex = x(6)
.OutlineFont = x(7)
.Strikethrough = x(8)
End With
End If
i = p + rn '※
Loop
End With
Next
Next
End Sub
2007以降なら楽なんですけどね。
chk = "うえお"
rep = "こんにちは"
n = Len(chk)
rn = Len(rep)
For Each ws In Worksheets
For Each tb In ws.TextBoxes
i = 1
Do
p = InStr(i, tb.Text, chk)
If p = 0 Then Exit Do
tb.Characters(p, n).Insert rep
i = p + rn
Loop
Next
Next
|
|
n
- 11/9/3(土) 12:31 -
