Powerpoint: sửa độ phân giải cho object,lưu và xóa object

Sub SetSelectedImageResolution()    

 Dim shp As Shape

    Dim imgPath As String 

    imgPath = Environ("USERPROFILE") & "\Desktop\pic1.png"

    If ActiveWindow.Selection.Type = ppSelectionShapes Then

        Set shp = ActiveWindow.Selection.ShapeRange(1)

        shp.LockAspectRatio = msoTrue

        shp.Width = 1280

        shp.Height = 1024

        shp.Export imgPath, ppShapeFormatPNG

       shp.Delete

    Else

        MsgBox "CHON1 OBJECT", vbExclamation

    End If

End Sub