deplacer des frames dynamiquement( module classe)

**patricktoulon** · 28/03/2019, 10h26

Bonjour a tous
pour un projet j'ai besoins de depacer des frames dynamiquement et horizontalement
ce n'est pas tout!!
ces frames quand elle se déplacent doivent prendre la place de celle qui est survolé dans un sens comme un autre (droite/gauche)

pour le deplacement ca va mais pour clamper les new positions ca n'est pas terrible il y a des erreurs de placement

code userform avec une frames principale"ib2" et 4 petite frames de couleurs dans celle ci

Code :

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

1
2
3
4
5
Option Explicit
Dim cl As New classmove
Private Sub UserForm_Activate()
 cl.classegroupe Me
End Sub

code classe

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
40
Option Explicit
Public WithEvents groupp As MSForms.Frame
Dim groupe() As New classmove
Public usf As Object
Public indexgroup As Long
Public parentgroup As Object
Dim dX As Single
Dim dY As Single
Public oldposition As Long
Sub classegroupe(uf)
    Dim Ctrl As Object
    indexgroup = 0
    For Each Ctrl In uf.Controls("ib2").Controls
        If Left(Ctrl.Name, 5) = "group" Then
            indexgroup = indexgroup + 1: ReDim Preserve groupe(0 To indexgroup)
            Set groupe(indexgroup).groupp = Ctrl
            Set groupe(indexgroup).usf = uf
        End If
    Next
End Sub
Private Sub groupp_Click()
    MsgBox groupp.Name
End Sub
Private Sub groupp_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    dX = X: oldposition = groupp.Left
End Sub
Private Sub groupp_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 2 Then groupp.Move groupp.Left + (X - dX), groupp.Top
End Sub
Private Sub groupp_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim f As Object, Ctrl As Object, L&
    If Button = 2 Then
        For Each Ctrl In groupp.Parent.Controls
            If Left(Ctrl.Name, 5) = "group" And Ctrl.Left < groupp.Left Then
                L = Ctrl.Left: Set f = Ctrl
            End If
        Next
        If Not f Is Nothing Then f.Left = oldposition: groupp.Left = L Else groupp.Left = oldposition
    End If
End Sub

pour les deplacer il faut rester appuyé avec le bouton droite de la souris

petite démo du problème
Nom : demo3.gif
Affichages : 598
Taille : 175,3 Ko

le but étant que la frame déplacée prenne la place de celle survolée et la survolé prenne l'ancienne position de celle qui est déplacée

un petit fichier en démo
merci pour le coup de main

Invité · 29/03/2019, 05h04

Envoyé par patricktoulon

Salut PatrickToulon,

Au lieu de gérer des déplacements, ne serait-il pas plus simple de permuter les propriétés backcolor des contrôles concernés ?
Pour cela, sur click-droit d'un contrôle, tu charges une matrice contenant les noms et les couleurs de tes contrôles en cours pour te servir de référence.

**eriiic** · 29/03/2019, 07h37

Bonjour à tous,

Code :

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

If Left(Ctrl.Name, 5) = "group" And Ctrl.Left < groupp.Left Then

Ctrl.Left <= groupp.Left non ?
eric

Invité · 29/03/2019, 08h14

Bonjour Eric et bonjour Patrick,

Je n'est pas chercher mais regarde du côté du drag end drop .

**patricktoulon** · 29/03/2019, 09h01

Bonjour a tous eriic ,Robert

@eriic"<=" oui si tu veux
robert j'ai regardé mais je n'ai aucune idée du comment faire j'ai essayé je n'ai pas de réponses dans ses évènements l'ors du déplacement
pour l'heure j'ai opté pour une mise dans l'ordre par rapport au left tant pis pour l'inter changement de place

code classe

edit: j'avais donné le mauvais code (corrigé)

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
40
41
42
43
44
45
46
47
48
49
50
Option Explicit
Public WithEvents groupp As MSForms.Frame
Dim groupe() As New classmove
Public usf As Object
Public indexgroup As Long
Public parentgroup As Object
Dim dX As Single
Dim dY As Single
Public OF As String
Sub classegroupe(uf)
    Dim ctrl As Object
    indexgroup = 0
    For Each ctrl In uf.Controls("ib2").Controls
        If Left(ctrl.Name, 5) = "group" Then
            indexgroup = indexgroup + 1: ReDim Preserve groupe(0 To indexgroup)
            Set groupe(indexgroup).groupp = ctrl
            Set groupe(indexgroup).usf = uf
        End If
    Next
End Sub
Private Sub groupp_Click()
    MsgBox groupp.Name
End Sub
Private Sub groupp_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    OF = groupp.Name
    dX = X
    End Sub
Private Sub groupp_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim ctrl
    If Button = 2 Then groupp.Move groupp.Left + (X - dX), groupp.Top
   End Sub
Private Sub groupp_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim ctrl As Object, T(3000), Tbis, i
    If Button = 2 Then
        'mise des frames dans une variable tableaux dans l'ordre de leur position
        For Each ctrl In groupp.Parent.Controls
            If Left(ctrl.Name, 5) = "group" And ctrl.Left < 5 Then ctrl.Left = 1
            If Left(ctrl.Name, 5) = "group" Then T(Int(ctrl.Left)) = ctrl.Name
        Next
        Tbis = Split(Application.Trim(Join(T, " ")))
        X = 5
        'deplacement des frames dans l'ordre du tableau
        For i = LBound(Tbis) To UBound(Tbis)
            With groupp.Parent.Controls(Tbis(i))
                .Left = X + (3 * i)
                X = X + .Width
            End With
        Next
    End If
End Sub

Nom : demo3.gif
Affichages : 539
Taille : 159,5 Ko

me reste un petit soucis d'ordre visuel
quand je déplace la 4 par exemple et je survole la 2 la 4 se trouve en dessous je voudrais que celle qui est draguée soit toujours au dessus
si vous avez mieux dites mois je prends

**eriiic** · 29/03/2019, 09h14

A la réflexion, à la place du n° ce n'est pas plutôt leur position que tu devrais comparer ?
A chaque manip, l'ordre de départ 1,2,3,4 est bouleversé.
eric

**patricktoulon** · 29/03/2019, 09h32

Envoyé par eriiic

A la réflexion, à la place du n° ce n'est pas plutôt leur position que tu devrais comparer ?
A chaque manip, l'ordre de départ 1,2,3,4 est bouleversé.
eric

A la réflexion, à la place du n° ce n'est pas plutôt leur position que tu devrais comparer ?
c'est ce que je fait non?

A chaque manip, l'ordre de départ 1,2,3,4 est bouleversé.
c'est le but eriic

j'ai x frames que je veux pouvoir déplacer horizontalement et qu'elle s'alignent toutes seule comme dans la démo

**patricktoulon** · 29/03/2019, 11h08

Bon j'ai opter pour le non remplacement de position simplement le changement d'ordre

Nom : demo3.gif
Affichages : 555
Taille : 317,2 Ko

deplacer des frames dynamiquement( module classe) [Toutes versions]

Macros et VBA Excel

Discussions similaires

Partager

Partager