Drag and Drop de CommandButtons

WUTED

XLDnaute Occasionnel
Bonjour le forum,

Etant encore débutant en VBA, je me retrouve face à un problème que j'ai du mal à résoudre, j'ai écrit récemment ce code pour effectuer des D&D sur un CommandButton dans un Userform :
Code:
Private OldPos As Single
Private PosX As Single
Private Etat As Boolean

Private Sub CommandButton1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Etat = True
    OldPos = CommandButton1.Left
    PosX = X
End Sub

Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Etat = True Then
        CommandButton1.Left = CommandButton1.Left + (X - PosX)
    End If
End Sub

Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim Rep As Integer
    Etat = False
    Rep = MsgBox("Voulez-vous vraiment modifier les horaires de cette tâche?", vbYesNo + vbQuestion, "Confirmation")
    If Rep = vbNo Then
        CommandButton1.Left = OldPos
    Else
        MsgBox "Modification effectuée !", vbInformation, "Information"
    End If
End Sub

Private Sub UserForm_Initialize()
    Me.Width = Application.Width
    Me.Height = Application.Height
    Etat = False

Et il fonctionne vraiment très bien, les mouvements du CommandButton sont trés fluides, j'ai aucun soucis. Seulement j'aimerai aujourd'hui faire exactement la même chose mais sur une Sheet, donc j'ai créer un CommandButton, puis j'ai c/c le code dans le code de ma Sheet en l'adaptant si nécessaire. Arrive le test et là, c'est le drame, ça fonctionne bien seulement si je déplace ma souris à 1mm/s et encore, si j'fais un "vrai" déplacement souris, mon bouton se téléporte loin vers la gauche, puis à droite...J'ai remarqué qu'au final mon X est trés irrégulier, par exemple il reste au alentours de 92,5 puis lors des déplacements, d'un coup, il arrive à -568 puis repasse à une valeur plus normale,sans que j'arrive à en trouver la raison. J'suis assez perdu pour le coup. Si quelqu'un avait une idée, ce serait super.

Merci d'avance,
WUTED
 

WUTED

XLDnaute Occasionnel
Re : Drag and Drop de CommandButtons

Au final j'me suis débrouillé, si ça intéresse quelqu'un ou qu'un jour quelqu'un a le même soucis, il suffit de remplacer les CommandButton1.Left = CommandButton1.Left + (X - PosX) par Me.Shapes("CommandButon1).IncrementLeft (X - PosX) par exemple, avec Me représentant la Sheet sur laquelle on travaille.
Bonne journée
 

Discussions similaires

Réponses
29
Affichages
918

Statistiques des forums

Discussions
312 203
Messages
2 086 196
Membres
103 153
dernier inscrit
SamirN