テキストボックスのフォンを変更するマクロ

質問

エクセルで沢山のテキストボックスのフォントを一括してMSPゴシックに変更するマクロとして以下を実行すると、処理自体は行われているようなのですが結果は元のフォンのままです。

Sub fonto()
Dim con As Integer
For con = 1 To ActiveSheet.TextBoxes.Count
ActiveSheet.TextBoxes(con).Characters.Text = ""
With Selection.Characters(Start:=1, Length:=1).Font
.Name = "ＭＳ Ｐゴシック"
.FontStyle = "標準"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Next con
End Sub

どこがおかしいのでしょうか？　
また、これだと文字を削除してしまうので、削除しない方法も知りたいのですが。

回答No.3

ja7awu · ベストアンサー

「元のフォントのまま」というのは、下のコードで < Selection > が、原因です。

For ～ Next で、テキストボックスの「インデックス番号」は、切り替えて
いても「セレクト」は、していませんよね。

With Selection.Characters(Start:=1, Length:=1).Font

それに、フォントを変えるのは、先頭の１文字だけですか？
もし、全体のフォント種でしたら、

With TextBoxes(con).Characters.Font

とするべきなのです。

あと、「文字を削除してしまう」のは、次の行があるからです。
ActiveSheet.TextBoxes(con).Characters.Text = ""

ここの TextBoxes(con) が 次の行の Selection の替わりにあったら・・・
おしかったぁ～

お礼

ありがとうございました。

＞With TextBoxes(con).Characters.Font

＞とするべきなのです。

正確には、With ActiveSheet.TextBoxes(con).Characters.Font でした。
でも助かりました。

回答No.2

nml

＃１の訂正です。貼り付ける場所を間違えてしまいました。
フォントだけを変えるのであれば、

Sub fonto()
Dim MyTextBox

For Each MyTextBox In ActiveSheet.TextBoxes
With MyTextBox
.Font.Name = "ＭＳ Ｐゴシック"
End With
Next

End Sub

文字を削除してしまったのは、

ActiveSheet.TextBoxes(con).Characters.Text = ""

の部分だと思います。

お礼

ありがとうございました。

回答No.1

nml

フォントだけの変更であれば、

Sub fonto()
Dim MyTextBox

For Each MyTextBox In ActiveSheet.TextBoxes
With MyTextBox
.Font.Name = "ＭＳ Ｐゴシック"
End With
Next

ActiveSheet.TextBoxes(con).Characters.Text = ""

の部分だと思います。
End Sub

文字を削除しているのは、

お礼

ありがとうございました。