XL 2013 les contrôles déplaçables dans un frames dans un userform

patricktoulon

XLDnaute Barbatruc
Bonjour à tous
je cherche a rendre mes controls auto repositionnables dans mon userform
j'entends par la que des que je le déplace avec la souris d'un coté ou de l'autre si il est en left plus petit qu'un autre controls il se repositionne avant lui
pour les gros bouton (label ) ça va, mais des que je suis sur des petits ça déraille
quelqu'un aurait une idée
dans l'exemple qui suit il y a 2 gros labels 3 petits et une frame vous pouvez les déplacer avec la souris
il faut que je trouve la combine pour que au repositionnement les 3 petit restent alignés
 

Pièces jointes

  • exemple XLD.xlsm
    20.1 KB · Affichages: 15

laurent950

XLDnaute Accro
Bonjour @patricktoulon

J'ai regarder le code, j'ai une proposition.
Cela n'existe pas
Ctrl.Move (c'est pas une méthode de l'objet)
Je pense que pour le coup si il y a plusieurs objet a créer et a déplacer pourquoi pas les mémoriser dans un module de classe
une variable collection, un module de classe on conserve les positions, l'objet, on test si ok on organise
c'est assez complexe j'ai mis un certain temps avant d'intégrer ton code.

C'est très latent a l'affichage mais ca fonctionne, j'ai pas gérer un objet qui en cache un autres
ni les position au global.

Je te remercierais jamais assez pour toutes ton aides en VBA alors ci cela peut t'aider bien que tu es bien plus fort que moi.

VB:
Public Function repositionne(ctrl As Object, group)
    Dim tbl() As Object
    Dim i As Integer
    Dim leftPos As Integer
    Dim controlWidth As Integer
    Dim ctrlTop As Integer
    Dim ctrlLeft As Integer
    Dim ctrlWidth As Integer
    Dim ctrlHeight As Integer
    ctrlTop = ctrl.Top '        Mémoriser la position Top du contrôle
    ctrlLeft = ctrl.Left '      Mémoriser la position Left du contrôle
    ctrlWidth = ctrl.Width '    Mémoriser la position Width du contrôle
    ctrlHeight = ctrl.Height '  Mémoriser la position Height du contrôle

    i = 0 ' Initialisation de i à 0
    ReDim tbl(i)

    ' Créez un tableau de contrôles triés par leur position Left
    For Each ctrl In group.Controls
        If ctrl.Tag = "litlebutton" Then
            controlWidth = ctrl.Width
            Set tbl(i) = ctrl
            i = i + 1 ' Incrémentation de i
            ReDim Preserve tbl(0 To i)
        End If
    Next ctrl
    ReDim Preserve tbl(UBound(tbl) - 1)

    ' Triez les contrôles par leur position Left
    For i = 1 To UBound(tbl) - 1
        For j = i + 1 To UBound(tbl)
            If tbl(i).Left > tbl(j).Left Then
                Set tmpCtrl = tbl(i)
                Set tbl(i) = tbl(j)
                Set tbl(j) = tmpCtrl
            End If
        Next j
    Next i

    ' Réorganisez les contrôles pour les aligner
    leftPos = 5
    For i = LBound(tbl) To UBound(tbl)
            ' Rétablir la position Top du contrôle
            If tbl(i).Width = ctrlWidth Then
                tbl(i).Left = ctrlLeft
            End If
    Next i
End Function

Laurent
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
bonjour laurent
incroyable on a eu pratiquement la ême idée et le même code
mais je n'ai pas pensé au cas ou je deplace un petit bouton ,il faut que les deux autres se déplacent avec
VB:
Public Function repositionne(ctrl As Object, group As Object)
    ReDim tbl(1 To group.Controls.Count, 1 To 3)
    ReDim tbl2(1 To group.Controls.Count, 1 To 3)
    Dim a&, q As Boolean
    'creation du tableau
    For Each ctrl In group.Controls
        i = i + 1
        tbl(i, 1) = ctrl.Name: tbl(i, 2) = ctrl.Left
    Next
    ' tri dans l'ordre par le left
    For i = 1 To UBound(tbl) - 1
        For a = i + 1 To UBound(tbl)
            If tbl(a, 2) < tbl(i, 2) Then
                n = tbl(i, 1): p = tbl(i, 2)
                tbl(i, 1) = tbl(a, 1): tbl(i, 2) = tbl(a, 2)
                tbl(a, 1) = n: tbl(a, 2) = p
            End If
        Next
    Next
    a = 5
    For i = 1 To UBound(tbl)
        tbl(i, 3) = a
        If i > 1 Then
            If tbl(i, 2) <> tbl(i - 1, 2) Then
                a = a + 5 + group.Controls(tbl(i - 1, 1)).Width
                tbl(i, 3) = a
            Else
                tbl(i, 3) = a
            End If
        End If
   Next

  For i = 1 To UBound(tbl)
  group.Controls(tbl(i, 1)).Left = tbl(i, 3)
 Next
 

   ' Cells(1, 1).Resize(UBound(tbl), 3) = tbl

End Function
 

patricktoulon

XLDnaute Barbatruc
avec ma version
il faut trouver moyen de detecter si l'element deplacer est un petit bouton et deplacer les deux autres avec lui
demo.gif
 

laurent950

XLDnaute Accro
Bonjour @patricktoulon

j'ai trouver cette astuce pour alligné les objets ensemble

' Remtre tous les ctrl.Left = 0 à ctrl.Left = controlLeft
For Each ctrl In group.Controls
If ctrl.Left = 0 Then
ctrl.Left = controlLeft
End If
Next ctrl

Par contre ici c'est un casse tête
' Réorganisez les contrôles pour les aligner
je sais pas si cela peut t'aider, il y a une logique que je trouve pas !

VB:
Public Function repositionne(ctrl As Object, group)
    Dim tbl() As Object
    Dim i As Integer
    Dim leftPos As Integer
    Dim controlLeft As Integer
    Dim controlWidth As Integer
    Dim controlHeight As Integer
    Dim controlTop As Integer
    Dim controlClik As String
        controlClik = ctrl.Name
    
    i = 0 ' Initialisation de i à 0

    ' Créez un tableau de contrôles triés par leur position Left
    For Each ctrl In group.Controls
    i = i + 1 ' Incrémentation de i
    ReDim Preserve tbl(0 To i)
        If ctrl.Tag = "litlebutton" Then
            If controlClik = CStr(ctrl.Name) Then
                controlLeft = ctrl.Left ' Mémoriser la position Left du contrôle
                controlWidth = ctrl.Width ' Mémoriser la position Width du contrôle
                controlHeight = ctrl.Height ' Mémoriser la position Height du contrôle
                controlTop = ctrl.Top ' Mémoriser la position Top du contrôle
            End If
        ' Changer les left de tous les "litlebutton"
        ctrl.Left = 0
        End If
        'If i - 1 = UBound(tbl) Then Exit For
        Set tbl(i - 1) = ctrl
    Next ctrl
    ReDim Preserve tbl(0 To i - 1)
    
    ' Remtre tous les ctrl.Left = 0 à ctrl.Left = controlLeft
    For Each ctrl In group.Controls
        If ctrl.Left = 0 Then
            ctrl.Left = controlLeft
        End If
    Next ctrl
    
    ' Triez les contrôles par leur position Left
    For i = 0 To UBound(tbl) - 1
        For j = i + 1 To UBound(tbl)
            If tbl(i).Left > tbl(j).Left Then
                Set tmpCtrl = tbl(i)
                Set tbl(i) = tbl(j)
                Set tbl(j) = tmpCtrl
            End If
        Next j
    Next i

    ' Réorganisez les contrôles pour les aligner
    Dim flag As Boolean
    leftPos = 5
        For i = 0 To UBound(tbl)
        ' Rétablir la position Top du contrôle
            'tbl(i).Top = controlTop
            If tbl(i).Tag = "litlebutton" Then
                'tbl(i).Top = controlTop
                If flag = False Then
                    For j = 0 To UBound(tbl)
                        If tbl(j).Tag = "litlebutton" Then
                            tbl(j).Left = leftPos
                            flag = True
                        End If
                    Next j
                End If
            Else
                tbl(i).Left = leftPos
            End If
            leftPos = leftPos + tbl(i).Width + 5
        Next i
End Function
 

patricktoulon

XLDnaute Barbatruc
re
Bonjour Laurent
en fait il faut qu'il soit déplacer en même avec la souris
VB:
Public WithEvents bouton As msforms.Label
Public WithEvents Box As msforms.Frame
Dim cls(1 To 150) As New UserForm1

Private Sub bouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ControlMove bouton, Button, X, Y
End Sub
Private Sub Box_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ControlMove Box, Button, X, Y
End Sub
Public Function ControlMove(ByVal ctrl As msforms.Control, ByVal Button As Integer, ByVal X As Single, ByVal Y As Single)
    Static EcX#: Static EcY#: Static tbl(1 To 3) As Object
    ctrl.ZOrder 0
    If Button = 1 Then
        If EcX = 0 Then
            EcX = X: EcY = Y
            For Each ctrlx In ctrl.Parent.Controls
                If Int(ctrlx.Left) = Int(ctrl.Left) Then q = q + 1: Set tbl(q) = ctrlx: ctrlx.ZOrder 0
            Next
        End If
        For i = 1 To 3
            If Not tbl(i) Is Nothing Then tbl(i).Move Int(ctrl.Left + (X - EcX))    ', ctrl.Top + (Y - EcY)
        Next
    Else
        If EcX > 0 Or EcY > 0 Then repositionne ctrl, ctrl.Parent
        EcX = 0: EcY = 0
    End If

End Function

Public Function repositionne(ctrl As Object, group As Object)
    ReDim tbl(1 To group.Controls.Count, 1 To 3)
     Dim a&, q As Boolean
    'creation du tableau
    For Each ctrl In group.Controls
        i = i + 1
        tbl(i, 1) = ctrl.Name: tbl(i, 2) = Int(ctrl.Left)
    Next
    ' tri dans l'ordre par le left
    For i = 1 To UBound(tbl) - 1
        For a = i + 1 To UBound(tbl)
            If tbl(a, 2) < tbl(i, 2) Then
                n = tbl(i, 1): p = tbl(i, 2)
                tbl(i, 1) = tbl(a, 1): tbl(i, 2) = tbl(a, 2)
                tbl(a, 1) = n: tbl(a, 2) = p
            End If
        Next
    Next
   Cells(1, 1).Resize(UBound(tbl), 3) = tbl
   a = 5
    For i = 1 To UBound(tbl)
        tbl(i, 3) = a
        If i > 1 Then
            If tbl(i, 2) <> tbl(i - 1, 2) Then
                a = a + 5 + group.Controls(tbl(i - 1, 1)).Width
                tbl(i, 3) = a
            Else
                tbl(i, 3) = a
            End If
        End If
    Next

    For i = 1 To UBound(tbl)
        group.Controls(tbl(i, 1)).Left = tbl(i, 3)
    Next


    Cells(1, 1).Resize(UBound(tbl), 3) = tbl

End Function








Private Sub UserForm_Activate()
    For Each ctrl In G1.Controls
        Select Case ctrl.Tag

        Case "litlebutton", "bigbutton"
            i = i + 1
            X = Array(30, 16)(Abs(ctrl.Tag = "litlebutton"))
            Set cls(i).bouton = ctrl

        Case "box"
            i = i + 1
            Set cls(i).Box = ctrl

        End Select
    Next
End Sub
 

laurent950

XLDnaute Accro
Re @patricktoulon

Cela fonctionne maintenant
je te laisse tous ce que j'ai tester en commentaire et le code est fait tu peux regarder

VB:
Public WithEvents bouton As MSForms.Label
Public WithEvents Box As MSForms.Frame
Dim cls(1 To 150) As New UserForm1

Private Sub bouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ControlMove bouton, Button, X, Y
End Sub
Private Sub Box_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ControlMove Box, Button, X, Y
End Sub
Public Function ControlMove(ByVal ctrl As MSForms.Control, ByVal Button As Integer, ByVal X As Single, ByVal Y As Single)
    Static EcX#: Static EcY#
    ctrl.ZOrder 0
    If Button = 1 Then
        If EcX = 0 Then EcX = X: EcY = Y
        ctrl.Move ctrl.Left + (X - EcX)    ', ctrl.Top + (Y - EcY)
    Else
        If EcX > 0 Or EcY > 0 Then repositionne ctrl, ctrl.Parent
        EcX = 0: EcY = 0
    End If

End Function

'''''''''Public Function repositionne(ctrl As Object, group)
'''''''''    ReDim tbl(1 To group.Width) As Object
'''''''''    Dim a&, q As Boolean
'''''''''    a = 5
'''''''''    For Each ctrl In group.Controls
'''''''''        Set tbl(ctrl.Left) = ctrl
'''''''''    Next
'''''''''
'''''''''    For i = 1 To UBound(tbl)
'''''''''        If Not tbl(i) Is Nothing Then
'''''''''            tbl(i).Move a
'''''''''            If Not q Then a = a + tbl(i).Width + 5
'''''''''            If tbl(i).Tag = "litlebutton" Then q = True Else q = False
'''''''''            Debug.Print tbl(i).Name
'''''''''        End If
'''''''''    Next
'''''''''End Function





Public Function repositionne(ctrl As Object, group)
    Dim tbl() As Object
    Dim i As Integer
    Dim leftPos As Integer
    Dim controlLeft As Integer
    Dim controlWidth As Integer
    Dim controlHeight As Integer
    Dim controlTop As Integer
    Dim controlClik As String
        controlClik = ctrl.Name
    
    i = 0 ' Initialisation de i à 0

    ' Créez un tableau de contrôles triés par leur position Left
    For Each ctrl In group.Controls
    i = i + 1 ' Incrémentation de i
    ReDim Preserve tbl(0 To i)
        If ctrl.Tag = "litlebutton" Then
            If controlClik = CStr(ctrl.Name) Then
                controlLeft = ctrl.Left ' Mémoriser la position Left du contrôle
                controlWidth = ctrl.Width ' Mémoriser la position Width du contrôle
                controlHeight = ctrl.Height ' Mémoriser la position Height du contrôle
                controlTop = ctrl.Top ' Mémoriser la position Top du contrôle
            End If
        ' Changer les left de tous les "litlebutton"
        ctrl.Left = 0
        End If
        'If i - 1 = UBound(tbl) Then Exit For
        Set tbl(i - 1) = ctrl
    Next ctrl
    ReDim Preserve tbl(0 To i - 1)
    
    ' Remtre tous les (ctrl.Tag = "litlebutton") ctrl.Left = 0 à ctrl.Left = controlLeft
    For Each ctrl In group.Controls
        If ctrl.Left = 0 Then
            ctrl.Left = controlLeft
        End If
    Next ctrl
    
    ' Triez les contrôles par leur position Left
    For i = 0 To UBound(tbl) - 1
        For j = i + 1 To UBound(tbl)
            If tbl(i).Left > tbl(j).Left Then
                Set tmpCtrl = tbl(i)
                Set tbl(i) = tbl(j)
                Set tbl(j) = tmpCtrl
            End If
        Next j
    Next i

'''''    ' Réorganisez les contrôles pour les aligner
'''''    Dim flag As Boolean
'''''    leftPos = 5
'''''        For i = 0 To UBound(tbl)
'''''        ' Rétablir la position Top du contrôle
'''''            'tbl(i).Top = controlTop
'''''            If tbl(i).Tag = "litlebutton" Then
'''''                'tbl(i).Top = controlTop
'''''                If flag = False Then
'''''                    For j = 0 To UBound(tbl)
'''''                        If tbl(j).Tag = "litlebutton" Then
'''''                            tbl(j).Left = leftPos
'''''                            flag = True
'''''                        End If
'''''                    Next j
'''''                End If
'''''            Else
'''''                tbl(i).Left = leftPos
'''''            End If
'''''            leftPos = leftPos + tbl(i).Width + 5
'''''        Next i


    ' Réorganisez les contrôles pour les aligner
    Dim flag As Boolean
    Dim col As New Collection
    leftPos = 5
        For i = 0 To UBound(tbl)
        ' Rétablir la position Top du contrôle
            'tbl(i).Top = controlTop
            If tbl(i).Tag = "litlebutton" Then
                'tbl(i).Top = controlTop
                If flag = False Then
                    tbl(i).Left = leftPos
                    controlLeft = leftPos
                    leftPos = leftPos + tbl(i).Width + 5
                    col.Add Item:=controlLeft, Key:=CStr(controlLeft)
                    flag = True
                End If
            Else
                tbl(i).Left = leftPos
                leftPos = leftPos + tbl(i).Width + 5
            End If
        Next i
 
' Réorganisez les contrôles pour les aligner col.Add Item:=leftPos, Key:=CStr(leftPos)
    Dim ColleftPos As Integer
    For Each ctrl In group.Controls
        If TypeOf ctrl Is MSForms.Label Then
            ' Code à exécuter si l'objet est un Label
                If ctrl.Tag = "litlebutton" Then
                    ColleftPos = col.Item(CStr(controlLeft))
                    ctrl.Left = ColleftPos
                End If
        Else
            ' Code à exécuter si l'objet n'est pas un Label
        End If
    Next ctrl
End Function

Private Sub UserForm_Activate()
    For Each ctrl In G1.Controls
        Select Case ctrl.Tag

        Case "litlebutton", "bigbutton"
            i = i + 1
            X = Array(30, 16)(Abs(ctrl.Tag = "litlebutton"))
            Set cls(i).bouton = ctrl

        Case "box"
            i = i + 1
            Set cls(i).Box = ctrl

        End Select
    Next
End Sub
 

jm.andryszak

XLDnaute Occasionnel
Bonjour
Si ça peut aider ?
les 3 petits boutons restent alignés.
Ma proposition n'est pas des meilleures et je suis curieux de voir la suite.
Bonne journée,

Option Explicit
Public WithEvents bouton As msforms.Label
'***********************************************
Private Sub bouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'***********************************************
Dim ctrl As Control
Dim Left
'***********************************************
For Each ctrl In G1.Controls
If ctrl.Tag = "litlebutton" Then
Set ctrl = bouton
bouton.Move X
'If X = 0 Then X = 50
'Left = bouton.Left
'End If
Next
'
UserForm1.Bt02.Left = Left
UserForm1.Bt04.Left = Left
UserForm1.Bt05.Left = Left
End Sub
'***********************************************
 

laurent950

XLDnaute Accro
Bonjour @patricktoulon

Comment tu fais l'animation, il faut qu'elle logiciel c'est pas mal pour expliquer.
Ton code semble fonctionner maintenant si tu veux le partager aussi, c'est un casse tête mais intéressant à travailler dessus pour trouver le principe.

Tu as essayé de placer le carré jaune sous le carré rouge, c'est à dire le carré rouge masque entièrement le carré jaune.

Comment se comporte le carré jaune il se remet a sa place ?

Dans mon code non il reste sous le carré rouge !
 

patricktoulon

XLDnaute Barbatruc
re
c'est normal le carré rouge est une frame donc la priorité ce qui fait que le relachement (le else dans le mouse move n'est pas opéré
il faut aller en dehors
sinon entre les label pas de soucis
VB:
Public WithEvents bouton As MSForms.Label
Public WithEvents Box As MSForms.Frame
Dim cls() As New UserForm1

Private Sub bouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ControlMove bouton, Button, X, Y
End Sub
Private Sub Box_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ControlMove Box, Button, X, Y
End Sub
Public Function ControlMove(ByVal ctrl As MSForms.Control, ByVal Button As Integer, ByVal X As Single, ByVal Y As Single)
    Static EcX#: Static EcY#: Static tbl(1 To 3) As Object
    ctrl.ZOrder 0
    If Button = 1 Then
        If EcX = 0 Then
            EcX = X: EcY = Y
            For Each ctrlx In ctrl.Parent.Controls
                If Int(ctrlx.Left) = Int(ctrl.Left) Then q = q + 1: Set tbl(q) = ctrlx: ctrlx.ZOrder 0
            Next
        End If
        For I = 1 To 3
            If Not tbl(I) Is Nothing Then tbl(I).Move Int(ctrl.Left + (X - EcX))    ', ctrl.Top + (Y - EcY)
        Next
    Else
        For I = 1 To 3
            If Not tbl(I) Is Nothing Then tbl(I).Move Int(ctrl.Left + (X - EcX)): tbl(I).ZOrder 0   ', ctrl.Top + (Y - EcY)
        Next
        If EcX > 0 Or EcY > 0 Then repositionne ctrl, ctrl.Parent

        Erase tbl
        EcX = 0: EcY = 0
    End If

End Function

Public Function repositionne(ctrl As Object, group As Object)
    ReDim tbl(1 To group.Controls.Count, 1 To 3)
    Dim a&, q As Boolean
    'creation du tableau
    For Each ctrlx In group.Controls
        I = I + 1
        tbl(I, 1) = ctrlx.Name: tbl(I, 2) = Int(ctrlx.Left):    'ctrlx.ZOrder 1
    Next
    ctrl.ZOrder 0
    ' tri dans l'ordre par le left
    For I = 1 To UBound(tbl) - 1
        For a = I + 1 To UBound(tbl)
            If tbl(a, 2) < tbl(I, 2) Then
                n = tbl(I, 1): p = tbl(I, 2)
                tbl(I, 1) = tbl(a, 1): tbl(I, 2) = tbl(a, 2)
                tbl(a, 1) = n: tbl(a, 2) = p
            End If
        Next
    Next
    a = 5
    For I = 1 To UBound(tbl)
        tbl(I, 3) = a
        If I > 1 Then
            If tbl(I, 2) <> tbl(I - 1, 2) Then
                a = a + 5 + group.Controls(tbl(I - 1, 1)).Width
                tbl(I, 3) = a
            Else
                tbl(I, 3) = a
            End If
        End If
    Next

    For I = 1 To UBound(tbl)
        group.Controls(tbl(I, 1)).Left = tbl(I, 3)
    Next
    Cells(1, 1).Resize(UBound(tbl), 3) = tbl
End Function

Private Sub UserForm_Activate()
   reclasse
End Sub
'****************************************************************************************************************
Sub reclasse()
 For Each ctrl In G1.Controls
        Select Case ctrl.Tag

        Case "litlebutton", "bigbutton"
            I = I + 1
            ReDim Preserve cls(1 To I): X = Array(30, 16)(Abs(ctrl.Tag = "litlebutton")): Set cls(I).bouton = ctrl

        Case "box"
            I = I + 1: ReDim Preserve cls(1 To I): Set cls(I).Box = ctrl


        End Select
    Next
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 206
Messages
2 086 220
Membres
103 158
dernier inscrit
laufin