Survol d'une image

Fait apparaître un commentaire au survol d'une image
le nom du shape commentaire est le nom de l'image+"Commentaire"

SurvolImage.xls

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINT) As Long
  Public Type POINT
    x As Long
    y As Long
  End Type
  Public p As POINT
  Public boucle
  Public Ogauche, OHaut, EchX, EchY

Sub OnMouseOver(ShapeP)
  ShapeCmt = ShapeP & "commentaire"
  GetCursorPos p
  If (p.y - OHaut) / EchY > ActiveSheet.Shapes(ShapeP).Top And _
    (p.y - OHaut) / EchY < ActiveSheet.Shapes(ShapeP).Top + ActiveSheet.Shapes(ShapeP).Height And _
     (p.x - Ogauche) / EchX > ActiveSheet.Shapes(ShapeP).Left And _
      (p.x - Ogauche) * EchX < ActiveSheet.Shapes(ShapeP).Left + ActiveSheet.Shapes(ShapeP).Width Then
    ActiveSheet.Shapes(ShapeCmt).Visible = True
    ActiveSheet.Shapes(ShapeCmt).Left = ActiveSheet.Shapes(ShapeP).Left
    ActiveSheet.Shapes(ShapeCmt).Width = ActiveSheet.Shapes(ShapeP).Width
    ActiveSheet.Shapes(ShapeCmt).Top = _
    ActiveSheet.Shapes(ShapeP).Top + ActiveSheet.Shapes(ShapeP).Height + 2
  Else
    ActiveSheet.Shapes(ShapeCmt).Visible = False
  End If
End Sub

Sub auto_open()
   boucle = True
  EchY = 1.3
  EchX = 0.8
  Do While boucle
    OHaut = 140 - Cells(ActiveWindow.ScrollRow, 1).Top * EchY
    Ogauche = 50 - Cells(ActiveWindow.ScrollColumn, 1).Left * EchX
    ShapeP = "Image1"
    OnMouseOver ShapeP
    ShapeP = "Image2"
    OnMouseOver ShapeP
    DoEvents
  Loop
End Sub

Sub auto_close()
  boucle = False
End Sub

Sub fin()
  boucle = False
End Sub