【Excel2003】マクロでテキストボックス編集

質問

お世話になります。
マクロを使ってある条件ごとにシート内全てのテキストボックスのフォントを変更するようにしたいと考えています。

条件
・テキストボックス内に(1)がある場合はテキストボックス内のフォントをMS明朝にする
・テキストボックス内に(2)がある場合はテキストボックス内のフォントをMSゴシックにする

イメージとしては、
(1)あいうえお←MS明朝
(2)あかさたな←MSゴシック

です。
この場合のマクロのプログラムを教えてください。
お願いいたします。

回答No.1

xls88 · ベストアンサー

あっているかどうか試してください。

Dim tbx As TextBox

For Each tbx In ActiveSheet.TextBoxes
If InStr(tbx.TEXT, "あいうえお") > 0 Then
tbx.Font.Name = "ＭＳ 明朝"
ElseIf InStr(tbx.TEXT, "あかさたな") > 0 Then
tbx.Font.Name = "ＭＳ ゴシック"
End If
Next

補足

早速の回答ありがとうございます。
出来ました！！
ありがとうございます。

もしよければまた教えてほしいのですが、
上記の例で
あいうえお←ＭＳ 明朝
あかさたな←ＭＳ ゴシック
でお願いしましたが、
例えば上記の「あ」のみフォントをHGP創英角ポップ体にすることも可能でしょうか？
何度もすいませんが教えてください。

回答No.3

xls88

複数ある場合にも対応してみました。
★1の行は不要なら消してください。
あるいはフォント名を正しい名前に変えて使ってください。

Dim tbx As TextBox
Dim txt As String
Dim s As Long

txt = "あ"
For Each tbx In ActiveSheet.TextBoxes
If InStr(1, tbx.Characters.TEXT, txt) > 0 Then
tbx.Font.Name = "ＭＳ 明朝"　'★1
Do
s = InStr(s + 1, tbx.Characters.TEXT, txt)
With tbx.Characters(s, Len(txt))
.Font.Name = "HGP創英角ポップ体"
End With
Loop While InStr(s + 1, tbx.Characters.TEXT, txt) > 0
End If
Next

回答No.2

xls88

≫No.1 この回答への補足

Dim tbx As TextBox
Dim txt As String
Dim s As Long

txt = "あ"
For Each tbx In ActiveSheet.TextBoxes
If InStr(tbx.Characters.TEXT, txt) > 0 Then
tbx.Font.Name = "ＭＳ 明朝"
s = InStr(tbx.Characters.TEXT, txt)
With tbx.Characters(s, Len(txt))
.Font.Name = "HGP創英角ポップ体"
End With
End If
Next

上記サンプルでは文字列内に該当文字が複数ある場合には対応していません。
複数ある場合はtbx.Charactersをループすることになると思います。