画像を最背面にし、ブックを後ろに回し、貼り付ける VBA

何がしたいかと言いますと、シートの複数の画像の位置を変えずに違うbookに貼り付けをする。

セルの位置座標を取得する方法ではなく、この方法でしたいので、どなたか分かる方いましたら
よろしくお願いいたします。

イメージはこのようなコードです。


Sub サンプル()
'四角作る
Dim R As Range
Set R = Range("A1:AP300")
With ActiveSheet.Shapes.AddShape(1, R.Left, R.Top, R.Width, R.Height).Fill
.ForeColor.RGB = RGB(0, 0, 255)
.Transparency = 0.5
End With

'↑これを最背面にするコード
①？？？

'シート全体のオブジェクト全て選択しcopyするコード
②？？？

'bookを後ろに回す
Windows(ActiveWorkbook.name).ActivateNext

Range("A1").Select
'Pasteするコード
③？？？

'最背面にしていた四角のみを削除するコード
④？？？

End Sub

①②③④のコードが知りたいと思っています。

No.1 ベストアンサー 回答者： enunokokoro 回答日時： 2019/06/06 15:22

継ぎ接ぎで作ったものなので、正しい設計ではないですが。

Sub サンプル()

Dim R As Range
Dim tobj As Shape

　Set R = Range("A1:AP300")
　ActiveSheet.Shapes.AddShape(1, R.Left, R.Top, R.Width, R.Height).Select
　With Selection.ShapeRange
　　.Fill.ForeColor.RGB = RGB(0, 0, 255)
　　.Fill.Transparency = 0.5
' ①
　　.ZOrder msoSendToBack
　End With
' ②
　ActiveSheet.DrawingObjects.Select
　Selection.Copy

　ActiveWindow.ActivateNext
' ③
　Range("A1").Select
　ActiveSheet.Paste
' ④
　For Each tobj In ActiveSheet.Shapes
　　If tobj.ZOrderPosition = 1 Then
　　　GoTo ShpDel
　　End If
　Next
　　　ShpDel:
　tobj.Delete

End Sub

細かい説明はしていませんが、なんとなく解ると思います。

この回答へのお礼

ありがとうございます。大変助かりました。

お礼日時：2019/06/06 20:23