Sub affusf() 'ajout des contôles dans le Usf existant
Dim nbrcom, i As Integer, x As Integer, sName As String
Dim oForm As Object, lbl As MSForms.Label, tbx As MSForms.TextBox, btn As MSForms.CommandButton
nbrcom = ActiveDocument.Fields.Count / 2 '????
Set oForm = ThisDocument.VBProject.VBComponents("UserForm1")
With oForm
For i = 1 To 10 'nbrcom
If i = 1 Then
.Properties("Height") = 124
.Designer.cmdok.Top = 66
.Designer.cmdannuler.Top = 66
Else
.Properties("Height") = 124 + (20 * i)
.Designer.cmdok.Top = 66 + (20 * i)
.Designer.cmdannuler.Top = 66 + (20 * i)
End If
Set lbl = .Designer.Controls.Add("Forms.Label.1")
With lbl
.Name = "lblfich" & i
.Left = 40
.Top = 40 + ((i - 1) * 22)
.Width = 65
.Height = 15.8
.Caption = "Fichier N° " & i & " :"
.TextAlign = 3
End With
Set tbx = .Designer.Controls.Add("Forms.TextBox.1")
With tbx
.Name = "fich" & i
.Left = 110
.Top = 40 + ((i - 1) * 22)
.Width = 168
.Height = 15.8
.BackColor = &HC0FFFE
End With
Set btn = .Designer.Controls.Add("forms.CommandButton.1")
With btn
.Name = "cmdbtn" & i
sName = .Name
.Left = 285
.Top = 40 + ((i - 1) * 22)
.Width = 24
.Height = 17
.Caption = "..."
End With
With .CodeModule
x = .CountOfLines
.InsertLines x + 1, "Private Sub " & sName & "_Click()"
.InsertLines x + 2, "Dialogue"
.InsertLines x + 4, "End Sub"
End With
Next i
End With
VBA.UserForms.Add (oForm.Name)
UserForms(0).Show
End Sub
Sub Dialogue() 'c'est la macro affectée aux boutons créés
Fichier = InputBox("Nom du fichier ?")
End Sub