Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim P As Range, o As OLEObject, x$, nom$
Set P = [F2:I6,H7:I9,F10:I11]
If Intersect(Target, P) Is Nothing Then Exit Sub
Cancel = True
'---au cas où les propriétés LinkedCell ne seraient pas renseignées---
For Each o In OLEObjects
If TypeName(o.Object) = "TextBox" Then _
If Not Intersect(o.TopLeftCell, P) Is Nothing Then _
o.LinkedCell = o.TopLeftCell.Address
Next
'---Déplacement---
1 x = UCase(InputBox("Nom ou numéro de la TextBox à déplacer :", , x))
If x = "" Then Exit Sub
For Each o In OLEObjects
nom = o.Name
If nom = x Or nom = "T" & x Then
o.LinkedCell = "": o.TopLeftCell = ""
Target = o.Object.Value: o.LinkedCell = Target.Address
o.Top = Target.Top + 5
o.Left = Target.Left + 5
x = Replace(nom, "T", "") 'numéro
OLEObjects("Label" & x).Top = o.Top
OLEObjects("Label" & x).Left = o.Left + o.Width
Exit Sub
End If
Next
GoTo 1
End Sub