Si problème à l'éxécution
cocher au préalable Microsoft Visual Basic for Application Extensiblity 5.3 (pour XL200)
'code à mettre dans un module standard
Sub MakeUserForm()
'[URL="http://www.tek-tips.com/faqs.cfm?fid=5757"]source[/URL]
Dim TempForm As Object
Dim NewButton As MSForms.CommandButton
Dim NewLabel As MSForms.Label
Dim NewTextBox As MSForms.TextBox
Dim NewOptionButton As MSForms.OptionButton
Dim NewCheckBox As MSForms.CheckBox
Dim X As Integer
Dim Line As Integer
Dim MyScript(4) As String
'This is to stop screen flashing while creating form
Application.VBE.MainWindow.Visible = False
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
'Create the User Form
With TempForm
.Properties("Caption") = "My User Form"
.Properties("Width") = 450
.Properties("Height") = 300
End With
'Create 10 Labels
For X = 0 To 9
Set NewLabel = TempForm.designer.Controls.Add("Forms.label.1")
With NewLabel
.Name = "FieldLabel" & X + 1
.Caption = "My Label " & X + 1
.Top = 20 + (12 * X)
.Left = 6
.Width = 90
.Height = 12
.Font.Size = 7
.Font.Name = "Tahoma"
.BackColor = &H80FFFF
End With
Next
'Create 10 Text Boxes
For X = 0 To 9
Set NewTextBox = TempForm.designer.Controls.Add("Forms.textbox.1")
With NewTextBox
.Name = "MyTextBox" & X + 1
.Top = 20 + (12 * X)
.Left = 100
.Width = 150
.Height = 12
.Font.Size = 7
.Font.Name = "Tahoma"
.BorderStyle = fmBorderStyleSingle
.SpecialEffect = fmSpecialEffectFlat
End With
Next
'Create 10 Check Boxes
For X = 0 To 9
Set NewCheckBox = TempForm.designer.Controls.Add("Forms.checkbox.1")
With NewCheckBox
.Name = "MyCheck" & X + 1
.Caption = ""
.Top = 20 + (12 * X)
.Left = 260
.Width = 12
.Height = 12
.Font.Size = 7
.Font.Name = "Tahoma"
.BackColor = &HFF00&
End With
Next
'Create 10 Labels -> result of Check Box
For X = 0 To 9
Set NewLabel = TempForm.designer.Controls.Add("Forms.label.1")
With NewLabel
.Name = "Result_Text" & X + 1
.Caption = ""
.Top = 20 + (12 * X)
.Left = 280
.Width = 150
.Height = 12
.Font.Size = 7
.Font.Name = "Tahoma"
.BackColor = &H80FFFF
End With
Next
'Create Event Handler Code For Each Check Box
'(True -> Upper Case of Text Box Value;False -> Lower Case of Text Box Value)
For X = 0 To 9
With TempForm.codemodule
Line = .countoflines
MyScript(0) = "Sub MyCheck" & X + 1 & "_Click()"
MyScript(1) = "If .MyCheck" & X + 1 & " = true then"
MyScript(2) = ".result_Text" & X + 1 & ".caption = ucase(.mytextbox" & X + 1 & ".value)"
MyScript(3) = ".result_Text" & X + 1 & ".caption = lcase(.mytextbox" & X + 1 & ".value)"
.insertlines Line + 3, MyScript(0)
.insertlines Line + 2, "With Me"
.insertlines Line + 3, MyScript(1)
.insertlines Line + 4, MyScript(2)
.insertlines Line + 5, "Else"
.insertlines Line + 6, MyScript(3)
.insertlines Line + 7, "End if"
.insertlines Line + 8, "End With"
.insertlines Line + 9, "End Sub"
End With
Next
'Show the form
VBA.UserForms.Add(TempForm.Name).Show
'Delete the form (Optional)
'ThisWorkbook.VBProject.VBComponents.Remove TempForm
End Sub
