Sub InsertBout()
Dim Sh As Worksheet
Dim Empl As Range
Dim Btn As OLEObject
Dim LaMacro$
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Set Sh = ThisWorkbook.ActiveSheet
With Sh
.Activate
For Each Btn In Sh.OLEObjects
If Btn.progID = "Forms.CommandButton.1" Then
Btn.Delete
End If
Next Btn
Set Empl = .Range("a1:c1")
Set Btn = Sh.OLEObjects.Add(ClassType:="Forms.CommandButton.1")
With Btn
'.Name = "Btn" & Replace(Sh.Name, " ", "")
.Left = Empl.Left
.Top = Empl.Top
.Width = Empl.Width
.Height = Empl.Height * (2 / 3)
' .Object.Caption = "Neu " & Sh.Name
End With
LaMacro = "Private Sub " & Btn.Name & "_Click()" & vbCrLf
LaMacro = LaMacro & "Call test" & vbCrLf
LaMacro = LaMacro & "End Sub"
With ThisWorkbook.VBProject.VBComponents(Sh.Name).CodeModule
Nligne = .CountOfLines + 1
.insertlines Nligne, LaMacro
End With
End With
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Sub Test()
MsgBox "Vous avez cliqué sur le bouton"
End Sub