Contrôles indexés

Marsh Posté le 13-07-2011 à 19:56:57

Bonjour,
Je voudrais créer un form au moment de l’exécution et je ne trouve pas les commandes (add.userform ?). Une fois créé je voudrais lui ajouter des controls et je n’y arrive pas non plus les exemples de l’aide ne marchent pas celui-ci notamment :

Code :

Dim Mycmd As Control
Private Sub CommandButton1_Click()
Set Mycmd = Controls.Add("MSForms.CommandButton.1", "CommandButton2", Visible)
Mycmd.Left = 18
Mycmd.Top = 150
Mycmd.Width = 175
Mycmd.Height = 20
Mycmd.Caption = "This is fun." & Mycmd.Name
End Sub
Private Sub UserForm_AddControl(ByVal Control As MSForms.Control)
Label1.Caption = "Control was Added."
End Sub

Une fois que j’aurais fait ça je voudrais accéder à mes contrôles façon indexée (par exemple CommandButon(1), CommandButon(2)…)

Tout aide est la bienvenue.

Merci

Reply

Marsh Posté le 13-07-2011 à 19:56:57

Reply

Marsh Posté le 13-07-2011 à 20:08:42

Salut,un exemple à adapter sur http://www.excel-downloads.com/for [...] outon.html
L'indexation n'existe pas de base en VBA pour les composants ( contrairement à VB6 il me semble ) , on peut utiliser la propriété Tag au moment de la création et l'incrémenter

voir égalment http://silkyroad.developpez.com/VB [...] itor/#LV-A

PS: à partir de l'exemple, une UserForm et des TextBoxes avec saisie
Ajouter un bouton et l'affecter à la procédure Création
ShTest est le CodeName de la feuille recevant les données saisies dans les TextBoxes
pour le CodeName voir http://www.developpez.net/forums/d [...] vba-bases/
Les avantages du CodeName étant de ne pas avoir à toucher au code VBA si l'utilisateur change le nom d'onglet de la feuille, déplace des feuilles ou en ajoute

Sous VBE Menu Outils/Références cocher Microsoft Forms 2.0 Object Library
sinon parcourir et sélectionner c:\windows\system32\FM20.dll

Option Explicit

Sub Création()
Dim UsfForm As Object
Dim NewB As MSForms.CommandButton
Dim TxtB As MSForms.TextBox
Dim i As Long, j As Long
Dim UsfName As String
Dim iLeft As Long, iTop As Long

ShTest.Cells.Clear
On Error Resume Next
If Err > 0 Then
Beep
End
End If

Application.VBE.MainWindow.Visible = False
Set UsfForm = ThisWorkbook.VBProject.VBComponents.Add(3)
With UsfForm
.Properties("Caption" ) = "USF et TextBoxes Dynamiques"
.Properties("Width" ) = 175
.Properties("Height" ) = 375
End With
UsfName = UsfForm.Name

Set NewB = UsfForm.Designer.Controls.Add("Forms.CommandButton.1" )
With NewB
.Height = 28
.Width = 70
.Left = 50
.Top = 315
.Caption = "Quitter"
End With

iLeft = 10: iTop = 10
For i = 1 To 12
Set TxtB = UsfForm.Designer.Controls.Add("Forms.Textbox.1", , True)
With TxtB
.Width = 150
.Height = 20
.Left = iLeft
.Top = iTop
.BorderStyle = fmBorderStyleSingle
.SpecialEffect = fmSpecialEffectFlat

Select Case i
Case 1, 5
.BackColor = &HC0E0FF
Case Else
.BackColor = &HC0FFFF
End Select
.Tag = i
End With
iTop = iTop + 25
Next i

With UsfForm.CodeModule
i = .CountOfLines
If i = 2 Then
.InsertLines i, "": i = i + 1
Else
i = 1
End If

.InsertLines i, "Const entrees_decimales_permises = "",0123456789": i = i + 1
.InsertLines i, "Const entrees_alpha_permises = "" ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz": i = i + 1
.InsertLines i, "Const Point = "".": i = i + 1
.InsertLines i, "Const Virgule = "",": i = i + 1
.InsertLines i, "": i = i + 1

.InsertLines i, "Private Sub CommandButton1_Click()": i = i + 1
.InsertLines i, " Unload Me": i = i + 1
.InsertLines i, "End Sub": i = i + 1

For j = 1 To 12
.InsertLines i, "": i = i + 1
.InsertLines i, "Private Sub TextBox" & j & "_Change()": i = i + 1
.InsertLines i, "Dim i As Integer": i = i + 1
.InsertLines i, " i = TextBox" & j & ".Tag": i = i + 1
.InsertLines i, " Select Case i": i = i + 1
.InsertLines i, " Case 1, 5": i = i + 1
.InsertLines i, " ShTest.Range(""A" & j & Chr(34) & " )=TextBox" & j & ".Text": i = i + 1
.InsertLines i, " Case Else": i = i + 1
.InsertLines i, " On Error Resume Next": i = i + 1
.InsertLines i, " ShTest.Range(""A" & j & Chr(34) & " )=CDbl(" & "TextBox" & j & ".Text)": i = i + 1
.InsertLines i, " Err.Clear": i = i + 1
.InsertLines i, " End Select": i = i + 1
.InsertLines i, "End Sub": i = i + 1

.InsertLines i, "": i = i + 1
.InsertLines i, "Private Sub TextBox" & j & "_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)": i = i + 1
.InsertLines i, " Select Case TextBox" & j & ".Tag": i = i + 1
.InsertLines i, " Case 1, 5": i = i + 1
.InsertLines i, " If InStr(entrees_alpha_permises, Chr(KeyAscii)) = 0 Then KeyAscii = 0": i = i + 1
.InsertLines i, " Case Else": i = i + 1
.InsertLines i, " If KeyAscii = Asc(Point) Then": i = i + 1
.InsertLines i, " If InStr(TextBox" & j & ".Text, Virgule) = 0 Then": i = i + 1
.InsertLines i, " KeyAscii = Asc(Virgule)": i = i + 1
.InsertLines i, " Else": i = i + 1
.InsertLines i, " KeyAscii = 0": i = i + 1
.InsertLines i, " End If": i = i + 1
.InsertLines i, " ElseIf InStr(entrees_decimales_permises, Chr(KeyAscii)) = 0 Then": i = i + 1
.InsertLines i, " KeyAscii = 0": i = i + 1
.InsertLines i, " ElseIf InStr(TextBox" & j & ".Text, Virgule) > 0 And KeyAscii = Asc(Virgule) Then": i = i + 1
.InsertLines i, " KeyAscii = 0": i = i + 1
.InsertLines i, " End If": i = i + 1
.InsertLines i, " End Select": i = i + 1
.InsertLines i, "End Sub": i = i + 1
Next j
.InsertLines i, "": i = i + 1
.InsertLines i, "Private Sub UserForm_Initialize()": i = i + 1
.InsertLines i, " TextBox1.setfocus": i = i + 1
.InsertLines i, "End Sub": i = i + 1
End With

VBA.UserForms.Add(UsfName).Show

' Pour voir à quoi ressemble l'UserForm créée
' Mettre l'instruction suivante en commentaire
' en tapant une apostrophe(') devant elle
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=UsfForm
End Sub

Message édité par kiki29 le 14-07-2011 à 08:09:34

---------------
Myanmar 90/91 : http://gadaud.gerard.free.fr/publi [...] index.html

Reply

Contrôles indexés

Sujets relatifs:

Leave a Replay