Moment de l'événement de la souris en panne

Question

On m'a demandé de coder la possibilité de cliquer sur une image dans Excel et d'y ajouter une forme (c'est un schéma corporel pour un physiothérapeute, la forme indiquera le site de la douleur du patient). Mon code fait ce OK en utilisant la souris vers le bas cas d'un contrôle d'image ActiveX:

Private Sub bodypic_MouseDown(ByVal Button As Integer, _ 
ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) 

ClickShape x, y 

End Sub 

---

Sub ClickShape(x As Single, y As Single) 

Dim shp As Shape 
Dim cursor As Point 

Set shp = ActiveSheet.Shapes.AddShape(msoShapeMathMultiply, x + ActiveSheet.Shapes("bodypic").Left, _ 
y + ActiveSheet.Shapes("bodypic").Top, 26, 26) 

With shp.Fill 

    .ForeColor.RGB = RGB(255, 0, 0) 
    .BackColor.RGB = RGB(255, 0, 0) 

End With 

shp.Line.Visible = False 

End Sub 

Le problème est que lorsque le curseur de la souris est sur le diagramme de la forme ne soit pas visible. Ce n'est que lorsque la souris est déplacée du diagramme que la forme apparaît.

J'ai essayé various methods pour actualiser l'écran, sélectionner une cellule, même changer la position du curseur via le SetCursor method in Lib user32. Rien ne semble fonctionner sauf pour l'utilisateur qui déplace réellement la souris. Pour recréer le problème: insérez un contrôle d'image ActiveX d'environ 200 x 500 px, ajoutez une image jpeg au contrôle, ajoutez le code de la souris à la feuille de calcul et le code de forme de clic à un module.

Answer 1

Ceci est très hacky mais je découvre que sa cachette et démasquage l'image permet de résoudre le problème:

ActiveSheet.Shapes("bodypic").Visible = False 
ActiveSheet.Shapes("bodypic").Visible = True 
End Sub 

Je serais heureux des réponses plus élégantes!

Answer 2

J'ai une quantité limitée de succès avec ce code: -

Option Explicit 

Private Type POINTAPI 
    x As Long 
    y As Long 
End Type 

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long 
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Integer, ByVal y As Integer) As Integer 

Sub ClickShape(ByVal x As Single, ByVal y As Single) 

    Dim Shp As Shape 
    Dim Pos As POINTAPI 

    GetCursorPos Pos 
    SetCursorPos Pos.x + 300, Pos.y 
    With ActiveSheet 
     With .Shapes("bodypic") 
      x = x + .Left 
      y = y + .Top 
     End With 
     Set Shp = .Shapes.AddShape(msoShapeMathMultiply, x, y, 26, 26) 
    End With 

    With Shp 
     .Name = "Mark1" 
     .Line.Visible = False 
     With .Fill 
      .ForeColor.RGB = RGB(255, 0, 0) 
      .BackColor.RGB = RGB(255, 0, 0) 
     End With 
    End With 
End Sub 

Essentiellement, ce qu'il fait est de déplacer le curseur sur l'image. Ensuite, il faut environ une seconde pour que la marque apparaisse. Le délai sera plus long, plus il y aura de marques. Notez que mon mouvement de 300 pixels est aléatoire. Vous devriez trouver où le déplacer, tant qu'il est en dehors de l'image. J'ai essayé de le déplacer immédiatement, mais cela n'a pas fonctionné, et le timing du retour serait difficile à cause des variations dans le délai.

J'ai expérimenté avec un autre concept où j'ai d'abord créé la marque et l'ai rendue invisible. Ensuite, sur MouseUp (MouseUp est l'événement le plus approprié), j'ai déplacé la marque et l'ai rendue visible. C'était plus rapide, mais cela vous limite à une seule marque ou vous condamne à beaucoup de gestion de nom. Donner un nom à la marque est un résidu de cette expérience. En fait, cela a semblé assez sympa puisque je pouvais déplacer la marque en cliquant plusieurs fois sur différentes positions. Si vous avez besoin d'une seule marque, je recommande de poursuivre cette idée.

Si vous avez besoin de plusieurs marques, un autre reste de mes expériences est l'idée d'ajouter une fonctionnalité pour supprimer (ou masquer) une marque, peut-être en double-cliquant.