Move Shape to TopLeftCell

[nniedzielski]

I am running this macro, and its working great, but once it crops the image the image is in row 8, how can I get the code to move the image to the top left cell?

Option Explicit
Sub CopyScreen()

Application.SendKeys "({1068})", True
DoEvents
Sheets("Sheets").Select
Cells(1, 1).Select
Sheets("Sheets").Paste
Cells(1, 1).Select
Dim shp As Shape
With ActiveSheet
    Set shp = .Shapes(.Shapes.Count)
End With

Dim h As Single, w As Single
h = -(700 - shp.Height)
w = -(500 - shp.Width)

shp.LockAspectRatio = False
shp.PictureFormat.CropRight = w
shp.PictureFormat.CropTop = h
shp.PictureFormat.CropBottom = 153
shp.TopLeftCell = True

End Sub

 

[Yongle]

shp.Top = Cells(ActiveWindow.ScrollRow, 1).Top
shp.Left = Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Left

 

[nniedzielski]

thank you