excel 2000 グラフを元の位置に図貼り付け

excel2000を利用しています。

アクティブなシートに作られているグラフを、全て図に変換して、それぞれ元の位置に同じ大きさで貼りなおしたいです。

いろんなサイトを調べて、下記、記述でグラフを図で貼り付けることまでは出来たのですが、元の位置に貼り付けるところが分かりません。

どのように修正すれば、いいでしょうか？ご指導よろしくお願いします。

Sub グラフを図として貼る()
Dim s As Object
For Each s In ActiveSheet.ChartObjects
s.Activate
ActiveChart.ChartArea.Select
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
ActiveSheet.Pictures.Paste
Next
End Sub

No.2 ベストアンサー 回答者： tsubuyuki 回答日時： 2013/02/18 00:09

失礼。

CTop = Selection.Top: CLeft = Selection.Left '追加


上記を


CTop = s.Top: CLeft = s.Left '追加


これで。

No.1 回答者： tsubuyuki 回答日時： 2013/02/17 00:05

コピーを取る前にグラフを選択するでしょうから、

その時についでに
　　.Top
　　.Left
で、上端と左端の座標を拾って、変数に入れておき、
貼り付けた後でその座標まで持っていけばよろしいかと。

例えば、質問中のコードをそのまま使うなら

Sub グラフを図として貼る()
Dim s As Object
Dim CTop As Single, CLeft As Single '追加
For Each s In ActiveSheet.ChartObjects
s.Activate
ActiveChart.ChartArea.Select
CTop = Selection.Top: CLeft = Selection.Left '追加
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
Range("A1").Select '追加
ActiveSheet.Pictures.Paste.Select 'ちょっと修正
Selection.ShapeRange.IncrementLeft CLeft '追加
Selection.ShapeRange.IncrementTop CTop '追加
Next
End Sub

これでとりあえずできると思いますよ。

この回答へのお礼

回答ありがとうございます。

早速、確認させていただいたところ、Ａ１セルに貼り付けとなっていました。

ActiveSheet.Pictures.Paste.Select 'ちょっと修正
Selection.ShapeRange.IncrementLeft CLeft '追加
Selection.ShapeRange.IncrementTop CTop '追加

の部分が効いていないと思います。さらに修正のアドバイスを頂ければ幸いです。

お礼日時：2013/02/17 08:25