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

エクセルで沢山のテキストボックスのフォントを一括して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 回答日時： 2003/03/13 21:58

「元のフォントのまま」というのは、下のコードで < 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 でした。
でも助かりました。

お礼日時：2003/03/13 23:15

No.2 回答者： nml 回答日時： 2003/03/13 20:22

＃１の訂正です。

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

Sub fonto()
Dim MyTextBox

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

End Sub

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

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

の部分だと思います。

この回答へのお礼

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

お礼日時：2003/03/13 23:11

No.1 回答者： nml 回答日時： 2003/03/13 20:19

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

Sub fonto()
Dim MyTextBox

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

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

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

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

この回答へのお礼

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

お礼日時：2003/03/13 23:10