こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excelvba 図形のコピー

Excelvba 2010のVBAについてご教授願います。

Sheet1にある楕円の図形をSheet2の結合セルの個所にコピーしたいのですが、
コピーできません(貼付できていないといった方が良いのかも)。
但し、コピー先の結合セルには文字が入っており(「有」という文字)、
この文字はそのまま残した方法で楕円の図のみ文字の上に上書きというか
文字にかぶせたいのです。

コードは以下の様に記述しました。

WorkSheets("Sheet2").Activate
Worksheets("Sheet1").Shapes("楕円").Select
Selection.Copy
ActiveSheets.Range("EE120").MergeArea.Select
ActiveSheet.Paste

投稿日時 - 2015-02-07 10:28:55

QNo.8912718

すぐに回答ほしいです

質問者が選んだベストアンサー

こんにちは。

普通にコピーして貼り付けるだけだったら、こんな感じです。

Sub Re8912718()
  Worksheets("Sheet1").Shapes("楕円").Copy
  Worksheets("Sheet2").Range("EE120").PasteSpecial
End Sub

もし、サイズをアクティブセルに合わせて変更したいという場合は、

  With Worksheets("Sheet2")
    With .Shapes(.Shapes.Count)
      .Height = ActiveCell.Height
      .Width = ActiveCell.Width
    End With
  End With

のような記述を上記に続けます。

コピーしたい楕円図形のオブジェクト名は"楕円"で間違いないでしょうか?
もし違っていれば当然エラーになるので気が付くとは思いますが、
もし、そこら辺でお困りの場合は、以下。
Sheet1にある楕円図形の名前をVBE上のイミディエイトウィンドウに列挙します。

Sub ChkShapeName()
Dim o As Shape
  For Each o In Worksheets("Sheet1").Shapes
    If o.AutoShapeType = msoShapeOval Then
      Debug.Print o.Name
    End If
  Next
End Sub

以上です。

投稿日時 - 2015-02-07 13:02:26

補足

下記の個所で、以下の様なメッセージが出力されます。
なぜなんでしょう?

実行時エラー'438'
オブジェクトは、このプロパティまたはメソッドをサポートしていません。

Worksheets("Sheet2").Range("EE120").PasteSpecial

投稿日時 - 2015-02-07 14:07:38

お礼

お礼が遅くなり、誠に申し訳ございませんでした。
おかげを持ちまして、無事に出来ました。
本当にありがとうございました。

投稿日時 - 2015-02-22 14:18:40

このQ&Aは役に立ちましたか?

7人が「このQ&Aが役に立った」と投票しています

回答(6)

ANo.6

#1,2,4,5です。

#5に加えてもう1例挙げておきますね。
違いを比べると一長一短ですが、
お好きな方、解り易いと感じる方を選んでください。
こちらは、登録したマクロについて何も処理しなくても踏襲されます。
その代わり、貼付け先のシート、セル範囲を選択してからでないと
貼り付け出来ません。

Sub Re8912718a()
  Worksheets("Sheet1").Shapes("楕円").Copy
  With Worksheets("Sheet2")
    .Select
    .Range("EE120").Select
    .Paste
  End With
  ActiveCell.Activate
End Sub

投稿日時 - 2015-02-08 19:01:53

ANo.5

#1,2,4です。#4補足欄への返答。

実質2ヶ所追加になります。
(1)元の図形に登録されたマクロ名を
   一旦、変数に格納しておいて、
(2)新しい図形に対して
   .OnActionプロパティにマクロ名を登録します。

Sub Re8912718追加()
Dim MacroName As String
  With Worksheets("Sheet1").Shapes("楕円")
    .Copy
    MacroName = .OnAction ' (1)
  End With
  With Worksheets("Sheet2")
    .Range("EE120").PasteSpecial
    .Shapes(.Shapes.Count).OnAction = MacroName ' (2)
  End With
End Sub

以上です。

投稿日時 - 2015-02-08 14:18:20

お礼

返事が遅くなり、誠に申し訳ございませんでした。
ご教授通り行いましたら、できました。
感謝!感謝!です。
ありがとうございました。

投稿日時 - 2015-02-22 14:14:26

ANo.4

#1-2です。
念の為、補足しておきますが、
こちらの環境、Win 7 x64, Excel2010 x64、では、
コピーした図形を、
#1のrange.PasteSpecial メソッドで、
問題なく貼り付けが出来ることを相当な回数確かめていますし、
.Copy と .PasteSpecial の間に、
Application.CutCopyMode = False 等の記述を挟むと、
ご指摘のエラーと同じ状況が再現できることも確認しています。
念の為。

投稿日時 - 2015-02-07 18:53:19

補足

お返事が遅れて誠に申し訳ございません。
小生のミスである事がわかりました。
大変失礼を致しました。

関連して再度質問をしたいのですが、
コピー元の図にマクロが登録されている場合は、
マクロ部分はコピーされないのでしょうか?
(実際に試した結果、図はコピーされるのは確認しましたが、
 マクロ部分がコピーされない現象は確認したつもりです。)。
コピーされないとすると、同じマクロを自動的にコピー後の図に
登録する事などはできないのでしょうね?

投稿日時 - 2015-02-08 11:20:17

ANo.3

テスト例として
SheetIに楕円を1つ貼り付け。
Sheet2のC11:D11のセルを結合(中央配置)して、セルの値を入れた(すでに値があれば何もしない)。
標準モジュールに
Sub test01()
Worksheets("Sheet1").Shapes(1).Copy
Worksheets("Sheet2").Activate
ActiveSheet.Paste
Worksheets("Sheet2").Shapes(1).Top = Range("c10").Top
Worksheets("Sheet2").Shapes(1).Left = Range("c10").Left - 10
End Sub
上記で質問者の状況(ニーズ)にこたえられない場合は、ご容赦を。
Range("c10").Left - 10のー10の±と数字を変えれば調節できます。Top位置も同じことができる。
貼り付けた図形の大きさには、貼り付け後、セルの高さや幅の変動に連動する設定もあるので
ご参考まで。
質問者の使っているCopyやPasteはシートに対して行えるもので、セルやMergeAreaを指定してはできない
のではないかな。そういうメトッドがVBAでは作られてないといえばよいのかな。

投稿日時 - 2015-02-07 18:03:09

ANo.2

#1です。補足欄への返答です。

> 下記の個所で、以下の様なメッセージが出力されます。
> なぜなんでしょう?
>
> 実行時エラー'438'
> オブジェクトは、このプロパティまたはメソッドをサポートしていません。
>
> Worksheets("Sheet2").Range("EE120").PasteSpecial

  Worksheets("Sheet1").Shapes("楕円").Copy
の行ではエラーがないようですから、
図形のコピーまでは正しく出来ていることになります。
図形をコピーしたデータがクリップボードに確保され、
貼り付けを待機している状態になります。
  Worksheets("Sheet2").Range("EE120").PasteSpecial
この行でご指摘の様なエラーで発生する原因として考えられるのは、
図形をコピーした記述の後に何かしら記述があって、
クリップボードのデータをキャンセルしている場合が考えられます。
もしも他に原因があるとしてもエラーが発生する過程は同じです。
また、こちらで想定できない原因があるとすれば、
何か特別なことをしているのに、こちらには伝わっていない、
ということですので、何か特別なことはないか、
探ってみてください。

図形をコピーした記述の後に何かしら記述がある場合、
まず、その記述を一旦消した上で実行して結果を確かめてから、
書き換えが難しいようでしたら、記述を見せてください。

取り急ぎ、以上です。

投稿日時 - 2015-02-07 16:20:43

あなたにオススメの質問