Sub Bouton189_Cliquer()
Application.CopyObjectsWithCells = True
With ActiveSheet
.DrawingObjects.Placement = 2
If .Name <> "Definitions" And .Name <> "fx" And .Name <> "Needs" Then _
.DrawingObjects("Zone combinée 160").TopLeftCell.Copy .[E10]
End With
End Sub
Sub Macro1()
' Macro enregistrée le 22/07/2019 par inadvertance
ActiveSheet.Shapes("Drop Down 160").Copy
ActiveSheet.Paste
End Sub
Salut job75Bonjour kay, salut JM,
Je comprends que vous voulez modifier la macro du bouton :
A+VB:Sub Bouton189_Cliquer() Application.CopyObjectsWithCells = True With ActiveSheet .DrawingObjects.Placement = 2 If .Name <> "Definitions" And .Name <> "fx" And .Name <> "Needs" Then _ .DrawingObjects("Zone combinée 160").TopLeftCell.Copy .[E10] End With End Sub
Sub Bouton189_Cliquer()
Dim P As Range, decal&, o As OLEObject, c As Range
Application.CopyObjectsWithCells = True
With ActiveSheet
If .Name = "Definitions" Or .Name = "fx" Or .Name = "Needs" Then Exit Sub
Set P = .[D5:M9] 'plage à adapter
decal = 5 'décalage à adapter
Application.ScreenUpdating = False
.DrawingObjects.Placement = 2
P.Copy P.Offset(decal) 'copie les cellules et les contrôles de formulaire
For Each o In .OLEObjects 'boucle pour copier les contrôles ActiveX
Set c = o.TopLeftCell
If Not Intersect(P, c) Is Nothing Then
With o.Duplicate 'duplication
.Left = o.Left
.Top = c.Offset(decal).Top + o.Top - c.Top
End With
End If
Next
End With
End Sub
Avec le fichier précédent les copies de CheckBox3 et CheckBox4 ne se voient pas pas car elles sont cachées par les TextBoxes.
Dans ce fichier (2) j'ai un peu modifié les positions pour qu'elles apparaissent.