[SIZE=2][COLOR=GRAY][B][I]DANS UN MODULE DE CODE STANDARD[/I][/B][/COLOR]
[COLOR=NAVY]Option Explicit[/COLOR]
[COLOR=NAVY]Public[/COLOR] Rep [COLOR=NAVY]As String[/COLOR]
[COLOR=NAVY]Function[/COLOR] InputBoxPwd(rPrompt [COLOR=NAVY]As String[/COLOR], [COLOR=NAVY]Optional[/COLOR] rTitle [COLOR=NAVY]As String[/COLOR], [COLOR=NAVY]Optional[/COLOR] rDefault [COLOR=NAVY]As String[/COLOR]) [COLOR=NAVY]As String[/COLOR]
[COLOR=GREEN]' myDearFriend! - www.mdf-xlpages.com[/COLOR]
[COLOR=NAVY]Dim[/COLOR] Usf [COLOR=NAVY]As Object
Dim[/COLOR] T [COLOR=NAVY]As String
Dim[/COLOR] N [COLOR=NAVY]As Byte[/COLOR]
[COLOR=GREEN]'Création d'un Userform "à la volée"[/COLOR]
[COLOR=NAVY]Set[/COLOR] Usf = ThisWorkbook.VBProject.VBComponents.Add(3)
[COLOR=NAVY]With[/COLOR] Usf
[COLOR=NAVY]For[/COLOR] N = 1 [COLOR=NAVY]To[/COLOR] 4
[COLOR=GREEN]'Propriétés du USF[/COLOR]
[COLOR=NAVY]If[/COLOR] N < 4 [COLOR=NAVY]Then[/COLOR]
.Properties(Choose(N, "Caption", "Height", "Width")) = Choose(N, rTitle, 110, 280)
[COLOR=NAVY]End If[/COLOR]
[COLOR=GREEN]'Création des 4 contrôles et du code associé aux boutons[/COLOR]
[COLOR=NAVY]With[/COLOR] .Designer.Controls.Add("Forms." & Choose(N, "TextBox", "Label", "CommandButton", "CommandButton") & ".1")
.Move Choose(N, 6, 6, 228, 228), _
Choose(N, 64, 6, 6, 30), _
Choose(N, 264, 210, 42, 42), _
Choose(N, 16, 54, 18, 18)
[COLOR=NAVY]Select Case[/COLOR] N
[COLOR=NAVY]Case[/COLOR] 1
[COLOR=GREEN]'Propriétés du TextBox[/COLOR]
.Value = rDefault
.PasswordChar = "*"
[COLOR=NAVY]Case Else[/COLOR]
.Caption = Choose(N - 1, rPrompt, "OK", "Annuler")
[COLOR=GREEN]'Création du code VBA associé aux boutons[/COLOR]
[COLOR=NAVY]If[/COLOR] N > 2 [COLOR=NAVY]Then[/COLOR]
T = "Private [COLOR=NAVY]Sub[/COLOR] " & .Name & "_Click(): "
[COLOR=NAVY]If[/COLOR] N = 3 [COLOR=NAVY]Then[/COLOR]
.Default = [COLOR=NAVY]True[/COLOR]
T = T & "Rep = Me.TextBox1.Text: "
[COLOR=NAVY]End If[/COLOR]
T = T & "Unload Me: [COLOR=NAVY]End[/COLOR] Sub"
[COLOR=NAVY]With[/COLOR] Usf.CodeModule
.InsertLines .CountOfLines + 1, T
[COLOR=NAVY]End With
End If
End Select
End With
Next[/COLOR] N
[COLOR=GREEN]'Afficher InputBox fictive[/COLOR]
VBA.UserForms.Add(.Name).Show
[COLOR=GREEN]'Retour réponse utilisateur[/COLOR]
InputBoxPwd = Rep
[COLOR=NAVY]End With[/COLOR]
[COLOR=GREEN]'Supprimer l'USF créé[/COLOR]
ThisWorkbook.VBProject.VBComponents.Remove Usf
[COLOR=NAVY]End Function[/COLOR][/SIZE]