Sub Pause1()
On Error Resume Next
ThisWorkbook.Sheets("Лист3").WindowsMediaPlayer1.Controls.Pause
End Sub

Private Sub RunRangeFromPoint()
  Dim obj As Object, OldPic As String, NewPic As String
  Dim cpos As POINTAPI
  InZoom = False
  On Error Resume Next
  With ActiveWindow
    Do
      If Not InZoom Then
        GetCursorPos cpos
        Set obj = .RangeFromPoint(cpos.x, cpos.y)
        Select Case TypeName(obj)
          Case "Picture":
                      NewPic = obj.Name
                      If OldPic <> NewPic Then Call ScalePic(OldPic, NewPic)
                      OldPic = NewPic
          Case Else:
                      Call ScalePic(OldPic)
                      OldPic = ""
        End Select
        DoEvents
      End If
    Loop Until DoStop
  End With
  Call ScalePic(OldPic)
  Application.StatusBar = ""
  Set obj = Nothing
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
Shp.OnAction = "Start"
Next
End Sub