Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Déplacer un contrôle dans un UserForms

Déplacer un contrôle dans un UserForms

3 réponses
Avatar
Pierre Archambault
Bonjour à tous,

J'aimerais savoir comment faire pour permettre à un usager de déplacer un
objet (image) à l'intérieur d'un userform.

Merci de vos lumières.

Pierre
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Michel Pierron
Bonsoir Pierre;
Brutalement comme ça à l'emporte pièce, dans le module UserForm:
Ajouter un contrôle CheckBox pour autoriser la modification dynamique.

Private WithEvents objImg As MSForms.Image
Private OkModif As Boolean

Private Sub CheckBox1_Click()
OkModif = CheckBox1.Value
If OkModif Then
MsgBox "Modification du contrôle:" & vbLf & vbLf _
& "Bouton Gauche pour redimensionner" & vbLf _
& "Bouton Droit pour déplacer.", 64
End If
End Sub

Private Sub objImg_MouseMove(ByVal Button As Integer _
, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If OkModif And Button = 1 Then RedimControl objImg, X, Y
If OkModif And Button = 2 Then MoveControl objImg, X, Y
End Sub

Private Sub RedimControl(obj As Object, ByVal X As Single, ByVal Y As
Single)
If X > 0 And Y > 0 Then
obj.Height = Y: obj.Width = X
End If
End Sub

Private Sub MoveControl(obj As Object, ByVal X As Single, ByVal Y As Single)
obj.Move obj.Left + (X), obj.Top + (Y)
End Sub

Private Sub UserForm_Initialize()
Set objImg = Me.Image1
End Sub

MP

"Pierre Archambault" a écrit dans le
message de news:0R6od.5397$
Bonjour à tous,

J'aimerais savoir comment faire pour permettre à un usager de déplacer un
objet (image) à l'intérieur d'un userform.

Merci de vos lumières.

Pierre




Avatar
Michel Pierron
Bonsoir Pierre;
Légèrement plus sophistiquée que la précédente (avec un checkbox à cocher
pour autoriser la modification).
Dans le module UserForm:
Option Explicit
Private WithEvents objImg As MSForms.Image
Private Xp!, Yp!, OkModif As Boolean

Private Sub CheckBox1_Click()
OkModif = CheckBox1.Value
If OkModif Then
objImg.MousePointer = 15
CheckBox1.ControlTipText = "Clic droit: " _
& "déplacer / Clic gauche: redimensionner"
Else
objImg.MousePointer = 0
CheckBox1.ControlTipText = ""
End If
End Sub

Private Sub objImg_MouseDown(ByVal Button%, ByVal Shift%, ByVal X!, ByVal
Y!)
Xp = X: Yp = Y
End Sub

Private Sub objImg_MouseMove(ByVal Button%, ByVal Shift%, ByVal X!, ByVal
Y!)
If OkModif And Button = 1 Then RedimControl objImg, X, Y
If OkModif And Button = 2 Then MoveControl objImg, X, Y
End Sub

Private Sub RedimControl(obj As Object, ByVal X!, ByVal Y!)
If X > 0 And Y > 0 Then obj.Height = Y: obj.Width = X
End Sub

Private Sub MoveControl(obj As Object, ByVal X!, ByVal Y!)
obj.Move obj.Left + (X - Xp), obj.Top + (Y - Yp)
End Sub

Private Sub objImg_MouseUp(ByVal Button%, ByVal Shift%, ByVal X!, ByVal Y!)
CheckBox1.Value = False
CheckBox1_Click
End Sub

Private Sub UserForm_Initialize()
Image1.ZOrder 0
Set objImg = Me.Image1
End Sub

Nettement plus sophistiqué mais aussi plus compliqué (un clic sur l'image
autorise la modification, un clic sur l'userform supprime la possibilité de
modification).
Toujours dans le module UserForm:
Option Explicit
Private Xp!, Yp!
Private WithEvents objh1 As MSForms.Label
Private WithEvents objh2 As MSForms.Label
Private WithEvents objh3 As MSForms.Label
Private WithEvents objm1 As MSForms.Label
Private WithEvents objm2 As MSForms.Label
Private WithEvents objb1 As MSForms.Label
Private WithEvents objb2 As MSForms.Label
Private WithEvents objb3 As MSForms.Label

Private Sub objb1_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
Xp = x: Yp = y
End Sub

Private Sub objb2_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
Xp = x: Yp = y
End Sub

Private Sub objb3_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
Xp = x: Yp = y
End Sub

Private Sub objh1_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
Xp = x: Yp = y
End Sub

Private Sub objh2_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
Xp = x: Yp = y
End Sub

Private Sub objh3_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
Xp = x: Yp = y
End Sub

Private Sub objm1_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
Xp = x: Yp = y
End Sub

Private Sub objm2_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
Xp = x: Yp = y
End Sub

Private Sub AxeX(ByVal x%, ByVal y%, S As Boolean)
Dim Toffset!: Toffset = Image1.Left
If S Then
Image1.Left = Image1.Left - Xp + x
Image1.Width = Image1.Width - (Image1.Left - Toffset)
Else
Image1.Width = Image1.Width - Xp + x
Image1.Left = Image1.Left - (Image1.Left - Toffset)
End If
HandPos
End Sub

Private Sub AxeY(ByVal x%, ByVal y%, S As Boolean)
Dim Toffset!
Toffset = Image1.Top
If S Then
Image1.Height = Image1.Height - Yp + y
Image1.Top = Image1.Top - (Image1.Top - Toffset)
Else
Image1.Top = Image1.Top - Yp + y
Image1.Height = Image1.Height - (Image1.Top - Toffset)
End If
HandPos
End Sub

Private Sub objb1_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
If Button Then Call AxeX(x, y, True): Call AxeY(x, y, True)
End Sub

Private Sub objb2_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
If Button Then Call AxeY(x, y, True)
End Sub

Private Sub objb3_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
If Button Then Call AxeX(x, y, False): Call AxeY(x, y, True)
End Sub

Private Sub objh1_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
If Button Then Call AxeY(x, y, False): Call AxeX(x, y, True)
End Sub

Private Sub objh2_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
If Button Then Call AxeY(x, y, False)
End Sub

Private Sub objh3_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
If Button Then Call AxeX(x, y, False): Call AxeY(x, y, False)
End Sub

Private Sub objm1_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
If Button Then Call AxeX(x, y, True)
End Sub

Private Sub objm2_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal y!)
If Button Then Call AxeX(x, y, False)
End Sub

Private Sub UserForm_Click()
Image1.MousePointer = 0
HandVis False
End Sub

Private Sub UserForm_Initialize()
Image1.PictureSizeMode = 1
Dim i As Byte
For i = 1 To 3
lblCreate "h" & i
lblCreate "b" & i
If i < 3 Then lblCreate "m" & i
Next i
HandPos
End Sub

' Création des labels poignées
Private Sub lblCreate(Id$)
Dim Ctl As Control
Set Ctl = Me.Controls.Add("forms.label.1", Id, False)
With Ctl
.BorderStyle = 1
.Width = 4: Ctl.Height = 4
.Left = 0: Ctl.Top = 0
.BackColor = &HFF00&
.ZOrder 0
Select Case .Name
Case "b1", "h3": .MousePointer = 6
Case "h2", "b2": .MousePointer = 7
Case "h1", "b3": .MousePointer = 8
Case "m1", "m2": .MousePointer = 9
End Select
If .Name = "h1" Then Set objh1 = Ctl
If .Name = "h2" Then Set objh2 = Ctl
If .Name = "h3" Then Set objh3 = Ctl
If .Name = "m1" Then Set objm1 = Ctl
If .Name = "m2" Then Set objm2 = Ctl
If .Name = "b1" Then Set objb1 = Ctl
If .Name = "b2" Then Set objb2 = Ctl
If .Name = "b3" Then Set objb3 = Ctl
End With
Set Ctl = Nothing
End Sub

Private Sub HandPos()
' haut gauche
Controls("h1").Left = Image1.Left - 2
Controls("h1").Top = Image1.Top - 2
' haut centre
Controls("h2").Left = Image1.Left + Image1.Width / 2 - 2
Controls("h2").Top = Controls("h1").Top
' haut droite
Controls("h3").Left = Image1.Left + Image1.Width - 2
Controls("h3").Top = Controls("h1").Top
' milieu gauche
Controls("m1").Left = Image1.Left - 2
Controls("m1").Top = Image1.Top + Image1.Height / 2 - 2
' milieu droite
Controls("m2").Left = Controls("h3").Left
Controls("m2").Top = Controls("m1").Top
' bas gauche
Controls("b1").Left = Controls("h1").Left
Controls("b1").Top = Image1.Top + Image1.Height - 2
' milieu bas
Controls("b2").Left = Controls("h2").Left
Controls("b2").Top = Controls("b1").Top
' bas droite
Controls("b3").Left = Controls("h3").Left
Controls("b3").Top = Controls("b1").Top
End Sub

Private Sub Image1_Click()
Image1.MousePointer = 15
HandVis True
End Sub

Private Sub Image1_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)
Xp = x: Yp = y
End Sub

Private Sub Image1_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)
If Button Then
Image1.Left = Image1.Left - Xp + x
Image1.Top = Image1.Top - Yp + y
HandPos
End If
End Sub

Private Sub HandVis(Optional V As Boolean = True)
Dim Ctl As Control
For Each Ctl In Me.Controls
Select Case Left$(Ctl.Name, 1)
Case "b", "h", "m": Ctl.Visible = V
End Select
Next Ctl
End Sub

Private Sub UserForm_QueryClose(Cancel%, CloseMode%)
Set objh1 = Nothing: Set objh3 = Nothing
Set objh2 = Nothing: Set objb2 = Nothing
Set objm1 = Nothing: Set objm2 = Nothing
Set objb1 = Nothing: Set objb3 = Nothing
End Sub

MP

"Pierre Archambault" a écrit dans le
message de news:0R6od.5397$
Bonjour à tous,

J'aimerais savoir comment faire pour permettre à un usager de déplacer un
objet (image) à l'intérieur d'un userform.

Merci de vos lumières.

Pierre




Avatar
docm
Bonjour Michel.
Un mot : chapeau!

"Michel Pierron" wrote in message
news:
Bonsoir Pierre;
Légèrement plus sophistiquée que la précédente (avec un checkbox à cocher
pour autoriser la modification).
Dans le module UserForm:
Option Explicit
Private WithEvents objImg As MSForms.Image
Private Xp!, Yp!, OkModif As Boolean

Private Sub CheckBox1_Click()
OkModif = CheckBox1.Value
If OkModif Then
objImg.MousePointer = 15
CheckBox1.ControlTipText = "Clic droit: " _
& "déplacer / Clic gauche: redimensionner"
Else
objImg.MousePointer = 0
CheckBox1.ControlTipText = ""
End If
End Sub

Private Sub objImg_MouseDown(ByVal Button%, ByVal Shift%, ByVal X!, ByVal
Y!)
Xp = X: Yp = Y
End Sub

Private Sub objImg_MouseMove(ByVal Button%, ByVal Shift%, ByVal X!, ByVal
Y!)
If OkModif And Button = 1 Then RedimControl objImg, X, Y
If OkModif And Button = 2 Then MoveControl objImg, X, Y
End Sub

Private Sub RedimControl(obj As Object, ByVal X!, ByVal Y!)
If X > 0 And Y > 0 Then obj.Height = Y: obj.Width = X
End Sub

Private Sub MoveControl(obj As Object, ByVal X!, ByVal Y!)
obj.Move obj.Left + (X - Xp), obj.Top + (Y - Yp)
End Sub

Private Sub objImg_MouseUp(ByVal Button%, ByVal Shift%, ByVal X!, ByVal
Y!)

CheckBox1.Value = False
CheckBox1_Click
End Sub

Private Sub UserForm_Initialize()
Image1.ZOrder 0
Set objImg = Me.Image1
End Sub

Nettement plus sophistiqué mais aussi plus compliqué (un clic sur l'image
autorise la modification, un clic sur l'userform supprime la possibilité
de

modification).
Toujours dans le module UserForm:
Option Explicit
Private Xp!, Yp!
Private WithEvents objh1 As MSForms.Label
Private WithEvents objh2 As MSForms.Label
Private WithEvents objh3 As MSForms.Label
Private WithEvents objm1 As MSForms.Label
Private WithEvents objm2 As MSForms.Label
Private WithEvents objb1 As MSForms.Label
Private WithEvents objb2 As MSForms.Label
Private WithEvents objb3 As MSForms.Label

Private Sub objb1_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

Xp = x: Yp = y
End Sub

Private Sub objb2_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

Xp = x: Yp = y
End Sub

Private Sub objb3_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

Xp = x: Yp = y
End Sub

Private Sub objh1_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

Xp = x: Yp = y
End Sub

Private Sub objh2_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

Xp = x: Yp = y
End Sub

Private Sub objh3_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

Xp = x: Yp = y
End Sub

Private Sub objm1_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

Xp = x: Yp = y
End Sub

Private Sub objm2_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

Xp = x: Yp = y
End Sub

Private Sub AxeX(ByVal x%, ByVal y%, S As Boolean)
Dim Toffset!: Toffset = Image1.Left
If S Then
Image1.Left = Image1.Left - Xp + x
Image1.Width = Image1.Width - (Image1.Left - Toffset)
Else
Image1.Width = Image1.Width - Xp + x
Image1.Left = Image1.Left - (Image1.Left - Toffset)
End If
HandPos
End Sub

Private Sub AxeY(ByVal x%, ByVal y%, S As Boolean)
Dim Toffset!
Toffset = Image1.Top
If S Then
Image1.Height = Image1.Height - Yp + y
Image1.Top = Image1.Top - (Image1.Top - Toffset)
Else
Image1.Top = Image1.Top - Yp + y
Image1.Height = Image1.Height - (Image1.Top - Toffset)
End If
HandPos
End Sub

Private Sub objb1_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

If Button Then Call AxeX(x, y, True): Call AxeY(x, y, True)
End Sub

Private Sub objb2_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

If Button Then Call AxeY(x, y, True)
End Sub

Private Sub objb3_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

If Button Then Call AxeX(x, y, False): Call AxeY(x, y, True)
End Sub

Private Sub objh1_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

If Button Then Call AxeY(x, y, False): Call AxeX(x, y, True)
End Sub

Private Sub objh2_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

If Button Then Call AxeY(x, y, False)
End Sub

Private Sub objh3_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

If Button Then Call AxeX(x, y, False): Call AxeY(x, y, False)
End Sub

Private Sub objm1_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

If Button Then Call AxeX(x, y, True)
End Sub

Private Sub objm2_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)

If Button Then Call AxeX(x, y, False)
End Sub

Private Sub UserForm_Click()
Image1.MousePointer = 0
HandVis False
End Sub

Private Sub UserForm_Initialize()
Image1.PictureSizeMode = 1
Dim i As Byte
For i = 1 To 3
lblCreate "h" & i
lblCreate "b" & i
If i < 3 Then lblCreate "m" & i
Next i
HandPos
End Sub

' Création des labels poignées
Private Sub lblCreate(Id$)
Dim Ctl As Control
Set Ctl = Me.Controls.Add("forms.label.1", Id, False)
With Ctl
.BorderStyle = 1
.Width = 4: Ctl.Height = 4
.Left = 0: Ctl.Top = 0
.BackColor = &HFF00&
.ZOrder 0
Select Case .Name
Case "b1", "h3": .MousePointer = 6
Case "h2", "b2": .MousePointer = 7
Case "h1", "b3": .MousePointer = 8
Case "m1", "m2": .MousePointer = 9
End Select
If .Name = "h1" Then Set objh1 = Ctl
If .Name = "h2" Then Set objh2 = Ctl
If .Name = "h3" Then Set objh3 = Ctl
If .Name = "m1" Then Set objm1 = Ctl
If .Name = "m2" Then Set objm2 = Ctl
If .Name = "b1" Then Set objb1 = Ctl
If .Name = "b2" Then Set objb2 = Ctl
If .Name = "b3" Then Set objb3 = Ctl
End With
Set Ctl = Nothing
End Sub

Private Sub HandPos()
' haut gauche
Controls("h1").Left = Image1.Left - 2
Controls("h1").Top = Image1.Top - 2
' haut centre
Controls("h2").Left = Image1.Left + Image1.Width / 2 - 2
Controls("h2").Top = Controls("h1").Top
' haut droite
Controls("h3").Left = Image1.Left + Image1.Width - 2
Controls("h3").Top = Controls("h1").Top
' milieu gauche
Controls("m1").Left = Image1.Left - 2
Controls("m1").Top = Image1.Top + Image1.Height / 2 - 2
' milieu droite
Controls("m2").Left = Controls("h3").Left
Controls("m2").Top = Controls("m1").Top
' bas gauche
Controls("b1").Left = Controls("h1").Left
Controls("b1").Top = Image1.Top + Image1.Height - 2
' milieu bas
Controls("b2").Left = Controls("h2").Left
Controls("b2").Top = Controls("b1").Top
' bas droite
Controls("b3").Left = Controls("h3").Left
Controls("b3").Top = Controls("b1").Top
End Sub

Private Sub Image1_Click()
Image1.MousePointer = 15
HandVis True
End Sub

Private Sub Image1_MouseDown(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)
Xp = x: Yp = y
End Sub

Private Sub Image1_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
y!)
If Button Then
Image1.Left = Image1.Left - Xp + x
Image1.Top = Image1.Top - Yp + y
HandPos
End If
End Sub

Private Sub HandVis(Optional V As Boolean = True)
Dim Ctl As Control
For Each Ctl In Me.Controls
Select Case Left$(Ctl.Name, 1)
Case "b", "h", "m": Ctl.Visible = V
End Select
Next Ctl
End Sub

Private Sub UserForm_QueryClose(Cancel%, CloseMode%)
Set objh1 = Nothing: Set objh3 = Nothing
Set objh2 = Nothing: Set objb2 = Nothing
Set objm1 = Nothing: Set objm2 = Nothing
Set objb1 = Nothing: Set objb3 = Nothing
End Sub

MP

"Pierre Archambault" a écrit dans le
message de news:0R6od.5397$
Bonjour à tous,

J'aimerais savoir comment faire pour permettre à un usager de déplacer
un


objet (image) à l'intérieur d'un userform.

Merci de vos lumières.

Pierre