スクショするコードと下のコード繋げて貼り付けてるんだけどその後に図のトリミング部分を削除を毎回手動でやってるんだけど
その手間を無くせないかなと思って

Sub 貼り付け()
　Range("A6").Select
ActiveSheet.Paste
Application.CommandBars("Format Object").Visible = False
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementTop 126.5453543307
Selection.ShapeRange.ScaleWidth 0.5493110633, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.8437515373, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 1439
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 809
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 324
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -63

Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementLeft 28.3636220472
Selection.ShapeRange.IncrementTop 0.00007874015748
Selection.ShapeRange.ScaleWidth 0.9641379475, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.9259154745, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 1439
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 809
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 310
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -37
Selection.Placement = xlFreeFloating
Selection.ShapeRange.LockAspectRatio = msoTrue

Range("A10").Select

ActiveWindow.WindowState = xlMaximized 'ウィンドウを最大化
End Sub