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

Question

下記のような形で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

fujillin · Accepted Answer

こんにちは

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

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

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

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

x-1919 · Answer

質問文を見る限り文字のコピペというよりか、テキストを設定しているだけですよね。
追加したオートシェイプの既定の書式が使われるため仕方ない動作といったところでしょうか。

既定の書式を変更する方法がリンク先に書いてあります。
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

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

こんにちは

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

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング