Afficher un message
Vieux 03/08/2003, 14h39   #14 (permalink)
@+Thierry
Guest
 
Messages: n/a
Par défaut >>> DATABASE XLD <<< RECENCEMENT FIL >> 21649 "VBA Effacement/Ecriture Macro"

Bonjour les Forumeurs...

Tiens je repasse par ce fil pour complément d'info....En ce qui concerne l'écriture d'une macro pour la création d'un UserForm à la Volée...

Dans mon post ci dessus du 21-04-03 20:47, je disais :"Mais ne me demandez pas de joindre les deux.... Je n'ai pas encore capté" en ce qui concernait la crétion de UserForm à la Volée...

Donc depuis j'ai eu à travailler la dessus et donc voici comment faire une Message Box par UserForm créé à la Volée puis détruit à la Sortie... :

Option Explicit
Dim USF As Object

Sub Message()
Dim Lab1 As Object, CmdB As Object
Dim X As Byte
Dim LaValeur As String
LaValeur = InputBox("Taper un Text !!", "Thierry's Démo", "Voici un Text")

Set USF = ThisWorkbook.VBProject.VBComponents.Add(3)
With USF
.Properties("Caption") = "Thierry's Démo"
.Properties("Width") = 150
.Properties("Height") = 80
End With

With USF.CodeModule
X = .CountOfLines
.insertlines X + 1, "'Thierry's Démo"
.insertlines X + 2, ""
.insertlines X + 3, "Sub CommandButton1_Click()"
.insertlines X + 4, " Unload Me"
.insertlines X + 5, " KillMe"
.insertlines X + 6, "End Sub"
.insertlines X + 7, ""
.insertlines X + 8, "Private Sub UserForm_QueryClose (Cancel As Integer, CloseMode As Integer)"
.insertlines X + 9, " KillMe"
.insertlines X + 10, "End Sub"
.insertlines X + 11, "'Sacré Boulot pour être détruit comme çà aussi sec ! lol @+Thierry !!!"
End With

Set Lab1 = USF.Designer.Controls.Add("Forms.Label.1")
With Lab1
.Caption = LaValeur
.Left = 10: .Top = 12: .Width = 145: .Height = 12
End With

Set CmdB = USF.Designer.Controls.Add("Forms.CommandButton.1")
With CmdB
.Caption = "OK"
.Left = 60: .Top = 30: .Width = 60: .Height = 18
End With
VBA.UserForms.Add(USF.Name).Show

Set USF = Nothing
Set Lab1 = Nothing
Set CmdB = Nothing
End Sub

Sub KillMe()
ThisWorkbook.VBProject.VBComponents.Remove USF
End Sub



Pour en savoir plus... Démos sur ce Sujet en ligne :

Fausse Message Box à la Position du Right Click
=> Fichier USF_Message_Position_du_RightClick.V01.zip (32k)

=> Fil de Discussion => DEMO UserForm éphémère (bis) avec GetCursorPos pour la position d'une MsgBox



[/i]UseForm de Recherche de String avec ListBox[/i]
=> Fichier USF_ListBox_A_La_Volee.zip (48k)

=> Fil de Discussion => DEMO Userform ListBox éphémère / Créé de toute pièce à la Volée en VBA !!


Comme ceci ce fil de discussion est bouclé !! (lol)

Bon Week End
@+Thierry