Discussion :

[lebowsky60]

Bonsoir,

je n'arrive pas a afficher les userforms que j'arrive à créer suivant une boucle voici le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub createUsf()
Dim i As Integer
Dim nbinstal As Integer
Dim usfname As String
Dim Usf As Object
 
nbinstal = ThisWorkbook.Sheets("Données").Cells(1, 1).Value
 
For i = 1 To nbinstal
    Set Usf = ThisWorkbook.VBProject.VBComponents.Add(3)
    usfname = ThisWorkbook.Sheets("Données").Cells(i + 1, 1).Value
    With Usf
        .Properties("Caption") = usfname
        .Properties("Height") = 250
        .Properties("Width") = 600
    End With
    Usf.show
Next i
End Sub

de plus j'aimerais pouvoir tester si les userforms existent et déjà et alors les montrer et là je patauge encore plus.
Quelqu'un aurait une idée ?
Merci

[lebowsky60]

bonjour,

j'ai fini par trouver ce code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Option Explicit
Dim Usf As Object
Dim obj As Object
 
Sub createUsf()
Dim i As Integer
Dim nbinstal As Integer
Dim usfname As String
 
nbinstal = ThisWorkbook.Sheets("Données").Cells(1, 1).Value
 
For i = 1 To nbinstal
    usfname = ThisWorkbook.Sheets("Données").Cells(i + 1, 1).Value
    ShowAnyForm (usfname)
Next i
End Sub
 
 
Sub ShowAnyForm(FormName As String, Optional Modal As FormShowConstants = vbModal)
 
        For Each obj In VBA.UserForms
            If StrComp(obj.Name, FormName, vbTextCompare) = 0 Then
                obj.Label1.Caption = "Form Already Loaded"
                obj.show Modal
                Exit Sub
            End If
        Next obj
 
On Error Resume Next
Set Usf = ThisWorkbook.VBProject.VBComponents.Add(3)
With Usf
    .Name = FormName
    .Properties("Caption") = FormName
End With
 
        With VBA.UserForms
            On Error Resume Next
            Err.Clear
            Set obj = .Add(FormName)
            If Err.Number <> 0 Then
                MsgBox "Err: " & CStr(Err.Number) & "   " & Err.Description
                Exit Sub
            End If
            obj.show Modal
        End With
End Sub

ça fonctionne mais lorsque mes userforms existe déjà, ils s'affichent bien mais deux autres sont créés.
avez vous une idée pour empêcher la création?

[lebowsky60]

ok je m'en suis sorti avec ça:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Option Explicit
Dim Usf As Object
Dim obj As Object
 
 
Sub CreateUsf()
Dim i As Integer
Dim nbinstal As Integer
Dim UsfName As String
 
nbinstal = ThisWorkbook.Sheets("Données").Cells(1, 1).Value
 
For i = 1 To nbinstal
    UsfName = ThisWorkbook.Sheets("Données").Cells(i + 1, 1).Value
    If UsfExist(UsfName) = False Then
        Set Usf = ThisWorkbook.VBProject.VBComponents.Add(3)
        With Usf
        .Name = UsfName
        .Properties("Caption") = UsfName
        End With
    End If
    ShowAnyForm (UsfName)
Next i
End Sub
Sub ShowAnyForm(FormName As String, Optional Modal As FormShowConstants = vbModal)
 
        For Each obj In VBA.UserForms
            If StrComp(obj.Name, FormName, vbTextCompare) = 0 Then
                obj.Label1.Caption = "Form Already Loaded"
                obj.show Modal
                Exit Sub
            End If
        Next obj
 
        With VBA.UserForms
            On Error Resume Next
            Err.Clear
            Set obj = .Add(FormName)
            If Err.Number <> 0 Then
                MsgBox "Err: " & CStr(Err.Number) & "   " & Err.Description
                Exit Sub
            End If
            obj.show Modal
        End With
 
 
End Sub
 
Function UsfExist(UsfName As String, Optional classeur As String) As Boolean
 
Dim VBComp As VBComponent
 
On Error Resume Next
Set VBComp = ThisWorkbook.VBProject.VBComponents(UsfName)
If VBComp Is Nothing Then
UsfExist = False
Else
UsfExist = True
End If
 
End Function

si ça peut aider quelqu'un.
bonne journée