Discussion :

[Gordon72]

Bonsoir tout le monde,

Je sollicite votre aide s'il vous plaît car j'aimerais récupérer certaines données sur des shapes.

J'ai un fichier Excel avec des plans correspondant à différentes structures. Je dois récupérer différentes zones sur ces plans. Je me suis donc fais une macro qui me permet de capturer les coordonnées du pointeur souris sur un contrôle d'image . Quand je clique pour la première fois, je place le coin supérieur gauche de mon rectangle et mon second clique vient terminer le coin inférieur droit. Les coordonnées des deux cliques me donnent donc la position, la hauteur et la largeur du rectangle.

Jusque là pas de problème sauf qu'en pratique selon le zoom de ma fenêtre le coin inférieur droit de mon rectangle ne suit pas le pointeur souris et je ne comprends pas pourquoi. Du coup mon rectangle n'a pas toujours la bonne largeur ou la bonne hauteur.

Deuxième chose, quand je clique pour la première fois, le contrôle image passe en premier plan et je ne vois pas grandir mon rectangle, pour cela il me faut sortir du contrôle et revenir dedans avec la souris pour y remédier. Une solution ?
Voici mon code que j'ai inséré dans la worksheet :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Private Sub CommandButton1_Click()
 
ActiveSheet.Shapes("Rectangle1").Visible = False
 
Range("I4:J4").ClearContents
Range("L4:M4").ClearContents
 
End Sub
 
Private Sub Image1_Click()
 
If [I4] <> "" And [L4] = "" Then
    Range("L4") = Range("F4")
    Range("M4") = Range("G4")
End If
 
If [I4] = "" Then
    Range("I4") = Range("F4")
    Range("J4") = Range("G4")
End If
 
End Sub
 
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 
Range("F4") = X
Range("G4") = Y
 
If [I4] <> "" And [L4] = "" Then
    ActiveSheet.Shapes("Rectangle1").Visible = True
    With ActiveSheet.Shapes("Rectangle1")
            .Top = Image1.Top + [J4]
            .Left = Image1.Left + [I4]
            .Width = [F4] - [I4]
            .Height = [G4] - [J4]
    End With
End If
 
End Sub

Voici le fichier : zoneDefinition.xlsm

Il suffit de cliquer sur "Def." pour rinitialiser le rectangle puis faire un premier clique dans la zone pour le coin sup gauche et un deuxième clique pour le coin inf droit.

Merci d'avance pour toute aide éventuelle.

Bonne soirée.

PS : je précise que ceci est un fichier exemple et que je ne peux me passer d'Excel car j'ai derrière des tableaux de valeurs stockant les dimensions et calculant d'autres données issues des résultats.

[Invité]

Bonjour,

Je n'ai pas réussi à régler votre problème pour faire apparaître le rectangle sur l'image 1 au fur et à mesure du déplacement de la souris.

Par contre, j'ai utilisé un artifice qui à l'air de fonctionner. Imaginez une image 2 identique en dimension à l'image 1 dans laquelle apparaît le rectangle. voir le fichier joint.

En ce qui concerne le zoom, quel est votre problème exactement, est-ce à l'impression ou lors du redimensionnement du rectangle ?

Cordialement.

[Gordon72]

Bonjour Eric,

Tout d'abord merci de vous être penché sur mon problème. La solution que vous m'avez proposée est pas mal du tout et je pense que je vais faire comme ça en traitant donc sur deux images.

Quant au problème de zoom en fait, je veux dire que le rectangle suit bien le mouvement de ma souris mais selon le zoom de ma feuille (100%,50%...) le coin inférieur droit de mon rectangle n'est pas forcément positionné sur le pointeur souris. En revanche dans le fichier que vous m'avez donné le problème ne se pose plus ^^.

Cdlt.