EXCELVBAオートシェイプの文字コピーの書式について

下記のような形でEXCEL2010でVBAを作成しオシェイプのテキストボックスのコメントを作成しています。
このテキストボックスに文字をコピーペーストして文字を追加したいのですがペーストされた文字色が白になってしまい、フォントサイズが大きくなって貼り付けされてしまいます。
毎回、ペースト後範囲指定して文字色・サイズ変更をしています。
できればペーストした文字色フォントサイズを最初から文字色黒、フォントサイズ9にしたいのですがどうしたらいいのでしょうかすいませんがお教えください。

' ｢test｣
Private Sub test()
'
'エラー時の処理
On Error GoTo ErrorHandler
'コメント表示
ActiveSheet.Shapes.AddShape(msoShapeRectangularCallout, Range(ActiveCell.Address).Left, Range(Cells(ActiveCell.Row + 1, ActiveCell.Column).Address).Top, 141, 114).Select
Selection.Characters.Text = "■●●●●●" & Chr(10) & "■●●●●●"
With Selection.Characters().Font
.Name = "ＭＳ Ｐゴシック"
.FontStyle = "標準"
.Size = 9
.ColorIndex = 1
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

Exit Sub
ErrorHandler:
MsgBox "■エラーが発生したため処理を終了しました。" & Chr(13) & "エラー" & Err.Number & Chr(13) & Err.Description

End Sub

No.2 ベストアンサー 回答者： fujillin 回答日時： 2017/09/12 10:48

こんにちは

ANo1様と同じように、私も既定の書式を思い浮かべましたが、どうやらそうでもないようですね。

＞このテキストボックスに文字をコピーペーストして～～
というのは手操作でのコピペと解釈しましたが、普通のテキストをコピペ（またはキー入力）する限りでは設定した書式は保たれています。

書式付のテキストをコピペした場合に、ご質問のような事象が見受けられ、その時に用いられる書式は既定の書式ではないようです。（私の環境では文字サイズが変わることはありませんでしたが・・・）
背景が濃い色の場合は白文字に、明るい色の場合は黒になるようです。
この現象は、VBAで作成した図形に限らす発生しますので、MS流に言えば「仕様です」ということになるのでしょうか。

これを避けるには、どうやら書式を外してペーストするくらいしかないようです。
具体的な方法としては、ペースト時のオプションとして「テキストのみ」にして貼り付ければ元の書式でペーストができます。
右クリックのメニューから「貼付けのオプション」-「テキストのみ」を選択するか、あるいは、リボンメニューの「クリップボード」-「貼り付け」-「貼付けのオプション」-「テキスト」を選択しても同様になります。

この回答へのお礼

NO.2様質問にご回答いただきありがとうございました。
NO.1様の回答とNO.2様の回答でエクセルの仕様ということと対処方法がよくわかりました。
すごく私としては知識が増え助かりました。
本当にありがとうございました
この内容の対応は右クリックのメニューから「貼付けのオプション」-「テキストのみ」で対応したいと思います。
本当にありがとうございました。

お礼日時：2017/09/12 19:08

No.1 回答者： x-1919 回答日時： 2017/09/11 14:36

質問文を見る限り文字のコピペというよりか、テキストを設定しているだけですよね。

追加したオートシェイプの既定の書式が使われるため仕方ない動作といったところでしょうか。

既定の書式を変更する方法がリンク先に書いてあります。
http://office-qa.com/Excel/ex150.htm

また、オートシェイプに設定するテキストの内容が都度違うのであれば、いっそのこと関数化しちゃうとか。

Sub MainProc()
　　On Error Goto ErrProc

　　Call CreateShape(xxxx, xxxx, xxxx, xxxx, "あいうえお")

ExitProc:
　　Exit Sub
ErrProc:
　　MsgBox Err.Description
End Sub

Sub CreateShape(aLeft As Single, aTop As Single, aWidth As Single, aHeight As Single, aText As String)
　　On Error Goto ErrProc

　　Dim s As Shape
　　Set s = ActiveSheet.Shapes.AddShape(msoShapeRectangularCallout, aLeft, aTop, aWidth, aHeight)
　　s.TextFrame.Characters.Text = aText

　　With s.TextFrame.Characters.Font
　　　　.Name = ・・・
　　　　・・・
　　　　・・・
　　End With

ExitProc:
　　Exit Sub
ErrProc:
　　Err.Raise 9999, , "■エラーが・・・"
End Sub

この回答へのお礼

NO.1様質問にご回答いただきありがとうございました。
返事の記載が遅くなりすいません。
昨日、関数化のVBAは私の知識が足りずできませんでしたが、
「既定の書式を変更する方法」を実際にやってみましたができませんでした。
なぜこうなってしまうのかの理屈もわかっていなかったのですが
NO.1様の回答とNO.2様の回答でエクセルの仕様ということと対処方法がよくわかりました。
すごく私としては知識が増え助かりました。本当にありがとうございました
この問題の対応はNO.2様の回答の
右クリックのメニューから「貼付けのオプション」-「テキストのみ」で対応したいと思います。
回答いただきありがとうございました。

お礼日時：2017/09/12 19:07