Création de plusieurs Frames dans UF & Localisation TB

[satiboy]

Bonjour à tous,

Je vous écris car je travaille actuellement sur un projet d'analyse de l'impact des pesticides sur notre alimentation.
Ma mission est la création d'un visuel "Impact" sur une pomme.

Je rencontre des difficultées lors de la création de nouvelles Frames sur un même UF.
Le but étant d'automatiser le visuel.

Ainsi pour chaques lignes ajoutées, ma macro se doit de créer :
-Dans 1 premier temps, le ToggleButton associé a la localisation de l'attaque sur la pomme (Pour ce faire je pensais à la création d'un cercle dans l'UF, peut être plus facile pour la localisation, si possible??)
-Et enfin, créer et associer une frame à la ligne créé
Je ne sais pas par où commencer...

Je vous ai mis en pièce jointe le fichier .xls

Merci pour votre aide

 

[satiboy]

Re : Création de plusieurs Frames dans UF & Localisation TB

Up 😀
Le projet me semble pourtant intéressant....

 

[job75]

Re : Création de plusieurs Frames dans UF & Localisation TB

Bonjour satiboy, bienvenue sur XLD,

Il me semble que vous vous compliquez inutilement la vie avec un USF.

Perso je mettrais l'image d'une pomme dans la feuille, toujours visible.

Un clic (sélection) sur la ligne d'une attaque afficherait l'attaque dans l'image (un cercle bien sûr).

Un bouton (ou autre chose) peut afficher toutes les attaques dans l'image.

A+

 

[job75]

Re : Création de plusieurs Frames dans UF & Localisation TB

Re,

Voyez le fichier joint et ces macros dans le code de la feuille :

Private Sub CommandButton1_Click()
Dim s As Shape
For Each s In Me.Shapes
  If s.Name Like "Attaque*" Then
    s.Visible = True
  End If
Next
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim s As Shape
For Each s In Me.Shapes
  If s.Name Like "Attaque*" Then
    s.Visible = Not Intersect(Target, [A:D]) Is Nothing And _
      Val(Replace(s.Name, "Attaque", "")) = Cells(Target.Row, 1)
  End If
Next
End Sub

Les images (ellipses) des attaques ont été renommées Attaque1, Attaque2...

L'image de la pomme est dans un contrôle Image ActiveX.

A+

 

[job75]

Re : Création de plusieurs Frames dans UF & Localisation TB

Bonjour satiboy, le forum,

En tâtonnant on détermine les coordonnées X et Y des attaques sur la pomme par :

Private Sub Image1_MouseMove(ByVal Button As Integer, _
  ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
MsgBox "X = " & X & vbLf & "Y = " & Y, , "Position" 'pour tâtonner
End Sub

Les 2 boutons permettent de repositionner ou de ranger les objets.

Fichier (2).

A+

 

[satiboy]

Re : Création de plusieurs Frames dans UF & Localisation TB

Merci beaucoup pour tes réponses job75.
Je m'en presse d'étudier toutes tes solutions.

 

[job75]

Re : Création de plusieurs Frames dans UF & Localisation TB

Re,

Pardon, il y a mieux pour déterminer la position :

Private Sub Image1_MouseMove(ByVal Button As Integer, _
  ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'cliquer sur la position pour obtenir ses coordonnées
If Button Then MsgBox "X = " & X & vbLf & "Y = " & Y, , "Position"
End Sub

Fichier (3).

A+

 

[job75]

Re : Création de plusieurs Frames dans UF & Localisation TB

Re,

Vous avez dû remarquer que la macro du post #7 est capricieuse : il faut sortir le curseur de l'image après le clic.

Utilisez donc cette version (4) avec ces macros :

Private Sub Image1_MouseMove(ByVal Button As Integer, _
  ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
memX = X 'mémorise
memY = Y
End Sub

Private Sub Image1_Click()
'cliquer sur la position pour obtenir ses coordonnées
MsgBox "X = " & memX & vbLf & "Y = " & memY, , "Position"
End Sub

Les variables memX et memY sont déclarées en haut de la feuille de code pour être mémorisées.

A+

 

[job75]

Re : Création de plusieurs Frames dans UF & Localisation TB

Re,

Hum, j'avions compliqué inutilement.

Pour connaître la position d'un objet, il suffit de lui affecter cette macro :

Sub Position()
Dim X, Y
On Error Resume Next
X = Me.Shapes(Application.Caller).Left - Image1.Left
Y = Me.Shapes(Application.Caller).Top - Image1.Top
If Err = 0 Then MsgBox "X = " & X & vbLf & "Y = " & Y, , "Position"
End Sub

et de cliquer dessus (clic droit pour le sélectionner).

Fichier (5).

A+