Option Explicit
Private WithEvents Img As MSForms.Image
Private Declare Function GetCursorPos& Lib "user32" (lpPoint As POINTAPI)
Private Declare Function GetAsyncKeyState% Lib "user32" (ByVal vKey&)
Private Declare Function GetKeyState% Lib "user32" (ByVal nVirtKey&)
Private Declare Function GetDC& Lib "user32" (ByVal hwnd&)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hwnd&, ByVal hDC&)
Private Declare Function GetDeviceCaps& Lib "gdi32" (ByVal hDC&, ByVal nIndex&)
Private Type POINTAPI
         X As Long
         Y As Long
End Type
Private ws As Worksheet
Dim CurPos As POINTAPI
Dim objTooTtip As OLEObject
Private Sub Class_Initialize()
         Set ws = ActiveSheet
End Sub
Public Property Set myImg(obj As OLEObject)
         Set Img = obj.Object
         Set objTooTtip = ws.OLEObjects(Img.Name & "Tooltip")
End Property
Private Sub img_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
                     ByVal X As Single, ByVal Y As Single)
         Dim b As Boolean, b2 As Boolean, hDC&
         With Application
             .Cursor = xlNorthwestArrow
             .CommandBars("Activex Control").Enabled = False
             .CommandBars("OLE Object").Enabled = False
             objTooTtip.BringToFront
             moveToolTip
             objTooTtip.Visible = True
             Do
                 moveToolTip
                 If GetAsyncKeyState(1) And &H8000 Then:  b = True: Exit Do: Else
                 b2 = False
                 With ActiveWindow
                     If TypeName(.RangeFromPoint(CurPos.X, CurPos.Y)) = "OLEObject" Then
                         If .RangeFromPoint(CurPos.X, CurPos.Y).Name = Img.Name Then b2 = True
                     End If
                 End With
                 DoEvents
             Loop While b2
             objTooTtip.Visible = False
             objTooTtip.Top = Img.Top: objTooTtip.Left = Img.Left
             .Cursor = xlDefault
             .CommandBars("Activex Control").Enabled = True
             .CommandBars("OLE Object").Enabled = True
             If b Then
                 .ScreenUpdating = False
                 .EnableEvents = False
                 ws.Next.Activate
                 ws.Activate
                 .ScreenUpdating = True
                 .EnableEvents = True
                 Call Test
             End If
          End With
End Sub
Private Sub moveToolTip()
         Dim hDC&
         GetCursorPos CurPos
         hDC = GetDC(0)
         With ActiveWindow
             objTooTtip.Left = (CurPos.X - .PointsToScreenPixelsX(0)) * 72 / GetDeviceCaps(hDC, 88&) * 100 / .Zoom + 10
             objTooTtip.Top = (CurPos.Y - .PointsToScreenPixelsY(0)) * 72 / GetDeviceCaps(hDC, 90&) * 100 / .Zoom + 10
         End With
         ReleaseDC 0, hDC
End Sub

Option Explicit
Global ImgCollection As Collection
Dim varImageHandler As ImageHandler
Sub Test()
      MsgBox "ЫЫЫЫЫЫЫЫ"
End Sub
Sub CreateImages()
      Dim sh As Shape, oleobj As OLEObject, n&
      For Each oleobj In ActiveSheet.OLEObjects
          If oleobj.OLEType = xlOLEControl Then
              If TypeOf oleobj.Object Is MSForms.Image Then n = n + 1
          End If
      Next
      Application.ScreenUpdating = False
      For Each sh In ActiveSheet.Shapes
          If sh.Type = msoPicture Then
              n = n + 1
              With ActiveSheet.OLEObjects.Add("Forms.Image.1", , 0, 0, , , , sh.Left, sh.Top, sh.Width + 2, sh.Height + 2)
                  .Object.PictureSizeMode = 3: sh.CopyPicture , xlBitmap
                  Set .Object.Picture = PastePicture(xlBitmap)
                  .Object.BorderStyle = 0: .Name = "Img" & n
              End With
              With ActiveSheet.OLEObjects.Add("Forms.Label.1", , 0, 0, , , , sh.Left, sh.Top, 90, 30)
                  .Object.BackColor = -2147483624: .Object.ForeColor = -2147483625:
                  .Object.BorderStyle = 0: .Visible = False: .Shadow = True
                  .Object.Caption = "Инструкция": .Name = "Img" & n & "Tooltip"
              End With
              sh.Delete
          End If
      Next
      Application.ScreenUpdating = True
      Application.OnTime Now + TimeSerial(0, 0, 1), "InitImages"
End Sub
Sub InitImages()
      Dim oleobj As OLEObject
      Set ImgCollection = New Collection
      For Each oleobj In ActiveSheet.OLEObjects
          If oleobj.OLEType = xlOLEControl Then
              If TypeOf oleobj.Object Is MSForms.Image Then
                  Set varImageHandler = New ImageHandler
                  Set varImageHandler.myImg = oleobj
                  ImgCollection.Add varImageHandler, oleobj.Name
              End If
          End If
      Next
      Beep
End Sub

Sub Tester()
    'set up some buttons
    With ActiveSheet
        AddMacroAndPopUp .Shapes("Rectangle 1"), "Test1", "popup 1"
        AddMacroAndPopUp .Shapes("Rectangle 2"), "Test2", "popup 2"
    End With
End Sub

'utility sub to configure a shape with a link and some pop-up text
Sub AddMacroAndPopUp(shp As Shape, macroName, txt As String)
    Dim ws As Worksheet
    shp.Parent.Hyperlinks.Add Anchor:=shp, Address:="#" & macroName & "()", ScreenTip:=txt
End Sub

'Example functions called from hyperlinks
'**************************************************
Function Test1()
    Debug.Print "Test1"
    Range("A1") = Now      'do something here
    Set Test1 = Selection  '<< must return a "destination" for the link,
                           '      in this case the clicked shape
End Function

'called from hyperlink
Function Test2()
    Debug.Print "Test2"
    Range("A2") = Now      'do something here
    Set Test2 = Selection
End Function