' Sous VBA Cocher dans Outils | Références Microsoft Forms 2.0 Object Library
' Pour cela : Cliquer Parcourir | Ajouter une référence
' puis aller dans C:\Windows\System32\ pour sélectionner FM20.dll
 
Option Explicit
 
Sub Tst()
    EssaiAvecBouton "Essai création par code"
End Sub
 
Sub EssaiAvecBouton(ByVal Titre As String)
Dim UserForm As Object
    Set UserForm = CreationFormAvecBouton(Titre)
    UserForm.Show
    DelComp UserForm.Name
    Unload UserForm
    Set UserForm = Nothing
End Sub
 
Function CreationFormAvecBouton(ByVal Titre As String) As Object
Dim Form As Object, Cbox1 As Object, Btn1 As Object, Btn2 As Object
Dim TxtBox1 As Object
Dim x As Long, Code As String
 
    Application.VBE.MainWindow.Visible = False
 
    Set Form = ThisWorkbook.VBProject.VBComponents.Add(3)
    With Form
        .Properties("Caption" ) = Titre
        .Properties("Width" ) = 250
        .Properties("Height" ) = 100
    End With
 
    Set TxtBox1 = Form.Designer.Controls.Add("forms.textbox.1" )
    With TxtBox1
        .Left = 60
        .Top = 20
    End With
 
    Set Btn1 = Form.Designer.Controls.Add("forms.commandbutton.1" )
    With Btn1
        .Caption = "Ok"
        .Left = 60
        .Top = 50
    End With
 
    With Form.CodeModule
        x = .CountOfLines + 1
        Code = "Sub CommandButton1_Click()" & vbCrLf
        Code = Code & "Dim s As String" & vbCrLf
        Code = Code & "  s=Textbox1.text" & vbCrLf
        Code = Code & "  ThisWorkBook.Coucou(s)" & vbCrLf
        Code = Code & "  Me.Hide" & vbCrLf
        Code = Code & "End Sub" & vbCrLf        
        .InsertLines x, Code
    End With
     
    Set Btn2 = Form.Designer.Controls.Add("forms.commandbutton.1" )
    With Btn2
        .Caption = "Annuler"
        .Left = Btn1.Left + Btn1.Width + 10
        .Top = Btn1.Top
    End With
 
    With Form.CodeModule
        x = .CountOfLines + 1        
        Code = "Sub CommandButton2_Click()" & vbCrLf
        Code = Code & "  Me.Hide" & vbCrLf
        Code = Code & "End Sub" & vbCrLf & vbCrLf    
        Code = Code & "Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)" & vbCrLf
        Code = Code & "   If CloseMode = 0 Then Cancel = True" & vbCrLf
        Code = Code & "End Sub" & vbCrLf        
        .InsertLines x, Code
    End With
 
    Set Cbox1 = Form.Designer.Controls.Add("forms.ComboBox.1" )
    With Cbox1
        .Left = TxtBox1.Left + TxtBox1.Width + 10
        .Top = TxtBox1.Top
        .Style = fmStyleDropDownList
        .BackColor = &HC0FFFF
        .ListRows = 32
    End With
 
    With Form.CodeModule
        x = .CountOfLines + 1        
        Code = "Private Sub UserForm_Initialize()" & vbCrLf
        Code = Code & " MajCbo1" & vbCrLf
        Code = Code & "End Sub" & vbCrLf        
        .InsertLines x, Code
    End With
     
    With Form.CodeModule
        x = .CountOfLines + 1        
        Code = "Sub MajCbo1()" & vbCrLf
        Code = Code & "Dim i as Integer" & vbCrLf
        Code = Code & "   With ComboBox1" & vbCrLf
        Code = Code & "       For i=1 to 10" & vbCrLf
        Code = Code & "           .AddItem i " & vbCrLf
        Code = Code & "       Next" & vbCrLf
        Code = Code & "   End With" & vbCrLf
        Code = Code & "End Sub" & vbCrLf        
        .InsertLines x, Code
    End With
     
    VBA.UserForms.Add (Form.Name)
    Set CreationFormAvecBouton = UserForms(UserForms.Count - 1)
 
End Function
 
Sub DelComp(ByVal Nom As String)
    With ThisWorkbook.VBProject.VBComponents
        .Remove .Item(Nom)
    End With
End Sub
 
Function Coucou(ByVal Chaine As String) As String
    Sh1.Cells.Clear
    Sh1.Cells(1, 1) = Chaine
End Function