Sub DeleteLastSelectedShape()
Dim iShCnt As Integer
Dim rng As ShapeRange
Select Case Application.Version
Case "16.0"
Set rng = ActiveWindow.Selection.ShapeRange
iShCnt = rng.Count
If iShCnt > 0 Then
Dim selIDs() As Integer
ReDim selIDs(iShCnt)
For ii = 1 To iShCnt
selIDs(ii) = ActiveWindow.Selection.ShapeRange(ii).Id
Next ii
ActiveWindow.Selection.ShapeRange(iShCnt).Delete
For ii = 1 To iShCnt - 1
For jj = 1 To ActiveSlide.Shapes.Range.Count
If ActiveSlide.Shapes.Range(jj).Id = selIDs(ii) Then
ActiveSlide.Shapes.Range(jj).Select (msoFalse)
End If
Next jj
Next ii
End If
Case Else
iShCnt = ActiveWindow.Selection.ShapeRange.Count
If iShCnt > 0 Then
ActiveWindow.Selection.ShapeRange(iShCnt).Delete
End If
End Select
End Sub
Function ActiveSlide() As Slide
On Error GoTo ErrHandler
Set ActiveSlide = ActivePresentation.Slides( _
ActiveWindow.View.Slide.Name)
Exit Function
ErrHandler:
Set ActiveSlide = Nothing
End Function