|
シートに貼り付けた元となる全ての画像にコピーをマクロ登録。
Sub コピー()
ActiveSheet.Shapes(Application.Caller).CopyPicture Appearance:=xlScreen, Format:=xlBitmap
End Sub
貼り付け先のセルを選択して実行。
Sub 貼り付け()
For i = 1 To Selection.Cells.Columns.Count
Wid = Wid + Selection.Cells(i).Width
Next
For i = 1 To Selection.Cells.Rows.Count
Hei = Hei + Selection.Cells(i).Height
Next
AD = Selection.Cells(1).Address
Application.ScreenUpdating = False
Range(AD).PasteSpecial
Selection.Width = Wid
Selection.Height = Hei
Range(AD).Select
Application.ScreenUpdating = True
End Sub
尚、クリップボードの内容の違い、操作ミス、その他のエラー処理は全く入ってないから、後は自分で考えてください。
|
|