Picture Macro Stopped working in 2010

[ElvisHess]

I have a macro (Below) which worked fine in Excel 2003. We've since upgraded to Excel 2010 and the macro no longer deletes and sizes the pictures being inserted. Can anyone help me adjust this?

Private Sub btnInsertPic_Click()
Application.ScreenUpdating = False
Dim myPicture As Variant
Dim p As Object
Dim Factor As Single
myPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.cgm; *.jpg; *.bmp; *.tif),*.gif; *.cgm; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")
If myPicture = False Then Exit Sub
For Each Page In Sheets
Page.Activate
Page.Range("BQ6").Select
ActiveSheet.Unprotect Password:="elvis1"
'DELETE THE OLD PICTURES
On Error Resume Next
Dim ShapeObject As Shape

For Each ShapeObject In ActiveSheet.Shapes

' Uncomment the following line to get a prompt of every shape object type.
' Write down all the Types it shows you, and use trial-and-error to figure out what type any given picture is.
' KNOWN TYPES: Form Buttons are Type 12, Drop Down Boxes are Type 8, JPegs and GIfs are Type 13
' The Message Box will pop-up for every shape it encounters, which may be dozens, so keep clicking "OK" until it finishes the loop

'MsgBox ShapeObject.Type

If ShapeObject.Type = 13 Or ShapeObject.Type = 7 Then
Call ShapeObject.Delete
End If
Next

'FINISHED DELETING OLD PICTURES
Range("BQ6").Select
Set p = ActiveSheet.Pictures.Insert(myPicture)
'Width and Height are in points (1/72 inch)
p.ShapeRange.LockAspectRatio = msoTrue
Hfactor = 4.58 / (p.Height / 72)
Wfactor = 6.96 / (p.Width / 72)
If Hfactor < Wfactor Then
Factor = Hfactor
Else
Factor = Wfactor
End If
p.Width = p.Width * Factor
p.Height = p.Height * Factor
ActiveSheet.Protect Password:="elvis1"
Next
Sheets("ProjectGate").Select
Application.ScreenUpdating = True
End Sub