VBA: cropping a screenshot with code

[JaredSorensen]

If anyone could me with this issue, that would be great. I take PrintScreens (Ctrl+PrntScr) of the maps and files frequently and paste them into Excel (Ctrl+v). However, I find it cumbersome to use the PictureEditor to crop each side of the image separately.

I have developed a simple way of cropping the image by adding textbox on top of the image, with the sides of the textbox demarcating the desired portion of the image that I want.

With the textbox selected (after putting it on top of the image), I execute the following macro below. The problem is that it seems to crop more than I ask it to. The right and top crops seem to have double the error that the left and bottom crops do (which come prior). Any ideas? I don't have much experience working with pixels, so I don't know whether there are inherent WYSIWYG limitations. Any help would be greatly appreciated.

Sub CropScreenPrintsWithSuperimposedTextbox()
'Big Assumption: assumes only two shapes (picture, textbox over desired area); a better
'method would allow it to apply textbox afterwards; The Textbox must be the currently selected shape
'point of For..Each is to select & identify the picture; there are surely other, better, approaches
For Each MyShape In ActiveSheet.Shapes
MyShape.Select
If Left(MyShape.Name, 4) = "Text" Or Left(MyShape.Name, 7) = "Rectang" Then
Dim NewTextBoxShape As ShapeRange 'shapes? shape?
Set NewTextBoxShape = Selection.ShapeRange
ElseIf Left(MyShape.Name, 2) = "Pi" Then
Dim OrigShape As ShapeRange 'shapes? shape?
Set OrigShape = Selection.ShapeRange
End If
Next

'first select desired shape to crop
OrigShape.Select
'get dimensions of origShape
origHeight = Selection.ShapeRange.Height
origWidth = Selection.ShapeRange.Width
origTop = Selection.ShapeRange.Top
origLeft = Selection.ShapeRange.Left

NewTextBoxShape.Select
txtHeight = Selection.ShapeRange.Height
txtWidth = Selection.ShapeRange.Width
txtTop = Selection.ShapeRange.Top
txtLeft = Selection.ShapeRange.Left

'next 4 lines were added to merely to confirm the calculation was correct; it appears to be correct
testLeft = txtLeft - origLeft
testRight = origWidth - txtWidth - txtLeft + origLeft
testBottom = origHeight - txtHeight - txtTop + origTop
testTop = txtTop - origTop

OrigShape.Select
Selection.ShapeRange.PictureFormat.CropLeft = txtLeft - origLeft
Selection.ShapeRange.PictureFormat.CropRight = origWidth - txtWidth - txtLeft + origLeft
Selection.ShapeRange.PictureFormat.CropBottom = origHeight - txtHeight - txtTop + origTop
Selection.ShapeRange.PictureFormat.CropTop = txtTop - origTop
NewTextBoxShape.Delete
End Sub

Jared