Discussion :

[florent77]

Bonjour à toutes et à tous,


Je lance mon formulaire USF1 avec notamment deux OptionButton :

- OptionButton 1 : démasquage de lignes, création d'un checkbox (activex) sur ma feuille au niveau des lignes démasquées et insertion de contrôles sur mon formulaire

- OptionButton 2 : masquage de lignes, suppression du chexckbox (activex) et masquage des contrôles de formulaire

Pour éviter des erreurs de positionnement de mon contrôle active x j'appelle une procédure à l'intérieur d'une autre (je n'ai trouvé que cette solution) :

Le problème est que mon formulaire disparaît, je n'ai donc plus accès aux nouveaux contrôles de formulaire...

Auriez-vous une idée pour contourner ce problème ?

Merci d'avance

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
Sub Procedure1()
 
Dim Ctrl As OLEObject
 
Application.ScreenUpdating = False
 
With USF1
 
    Select Case .OptionButton2
 
            Case True
 
            Rows("435:546").RowHeight = 0
 
            .Frame1.Visible = False
            .Frame2.Visible = False
            .Frame3.Visible = False
 
            For Each Ctrl In ActiveSheet.OLEObjects
                On Error Resume Next
                Ctrl.Delete
            Next Ctrl
 
 
            Case False
 
            .Frame1.Visible = True
            .Frame2.Visible = True
            .Frame3.Visible = True
 
            Rows("435:443").RowHeight = 12.75
            Rows("445:446").RowHeight = 12.75
            Rows("448:474").RowHeight = 12.75
            Rows("496:515").RowHeight = 12.75
 
            Call Procedure2
 
    End Select
 
End With
 
End Sub

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
Sub Procedure2()
 
Dim Obj1 As OLEObject
Dim L1, T1 As Double
 
Application.ScreenUpdating = False
 
L1 = Range("K450").Left
T1 = Range("K450").Top
 
Set Obj1 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
DisplayAsIcon:=False, Left:=L1, Top:=T1, Width:=120, Height:=20)
 
Obj1.Name = "Reduire_STAI"
Obj1.PrintObject = False
Obj1.Placement = 1
Obj1.Object.Caption = "Réduire STAI"
Obj1.Object.BackColor = RGB(219, 219, 219)
 
End Sub

[Invité]

Bonjour,

Je n'ai pas testé, mais on devrait plutôt avoir un truc comme cela dans votre formulaire :

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
62
63
64
65
66
67
68
69
70
 
 
Private Sub OptionButton1_Click()
 
Dim Obj1 As OLEObject
Dim L1, T1 As Double
 
    If OptionButton1 = True Then
 
            Application.ScreenUpdating = False
 
            Me.Frame1.Visible = True
            Me.Frame2.Visible = True
            Me.Frame3.Visible = True
 
            With ActiveSheet
                .Rows("435:443").RowHeight = 12.75
                .Rows("445:446").RowHeight = 12.75
                .Rows("448:474").RowHeight = 12.75
                .Rows("496:515").RowHeight = 12.75
 
                L1 = .Range("K450").Left
                T1 = .Range("K450").Top
 
                Set Obj1 = .OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
                DisplayAsIcon:=False, Left:=L1, Top:=T1, Width:=120, Height:=20)
 
            End With
 
            With Obj1
                .Name = "Reduire_STAI"
                .PrintObject = False
                .Placement = 1
                .Object.Caption = "Réduire STAI"
                .Object.BackColor = RGB(219, 219, 219)
            End With
 
            Application.ScreenUpdating = True
 
      End If
 
 
End Sub
 
Private Sub OptionButton2_Click()
 
Dim Ctrl As OLEObject
 
    If OptionButton2 = True Then
 
       Application.ScreenUpdating = False
 
       Me.Frame1.Visible = False
       Me.Frame2.Visible = False
       Me.Frame3.Visible = False
 
       With ActiveSheet
            .Rows("435:546").RowHeight = 0
            If .OLEObjects.Count > 0 Then
               For Each Ctrl In .OLEObjects
                        Ctrl.Delete
               Next Ctrl
            End If
       End With
 
       Application.ScreenUpdating = True
 
    End If
 
End Sub

[florent77]

Bonjour Eric, bonjour à tous,

Merci beaucoup Eric, ton code est bien plus propre

J'ai toujours néanmoins ce problème de fermeture de l'USF quand je clique sur l'OptionButton1.

Peut-être le "Set Obj1" qui prend le dessus ?

Code :

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

Set Obj1 = .OLEObjects.Add(ClassType:="Forms.CheckBox.1"

J'ai essayé :

Code :

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

Set Obj1 = Nothing

mais non...

[Invité]

Mettez en ligne tout le code présent dans l'USF.

[florent77]

voici :

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
Private Sub UserForm_activate()
    Application.ScreenUpdating = False
    OptionButtonMCST_Oui.Value = True
    Framedep.Visible = False
    Frameanxiete.Visible = False
    FrameNPI.Visible = False
    Framezarit.Visible = False
    FrameCS.Visible = False
End Sub
 
 
 
Private Sub OptionButtonDuree2_Click()
 
Dim Ctrl As OLEObject
 
    If OptionButtonDuree2 = True Then
 
            Application.ScreenUpdating = False
 
            Me.Framedep.Visible = False
            Me.Frameanxiete.Visible = False
            Me.FrameNPI.Visible = False
            Me.Framezarit.Visible = False
            Me.FrameCS.Visible = False
 
            With ActiveSheet
                .Rows("435:546").RowHeight = 0
 
                If .OLEObjects.Count > 0 Then
                    For Each Ctrl In .OLEObjects
                        Ctrl.Delete
                    Next Ctrl
                End If
            End With
 
            Application.ScreenUpdating = True
 
        End If
 
End Sub
 
 
 
Private Sub OptionButtonDuree3_Click()
 
Dim Obj1 As OLEObject
Dim L1, T1 As Double
 
    If OptionButtonDuree3 = True Then
 
            Application.ScreenUpdating = False
 
            Me.Framedep.Visible = True
            Me.Frameanxiete.Visible = True
            Me.FrameNPI.Visible = True
            Me.Framezarit.Visible = True
            Me.FrameCS.Visible = True
 
            Me.OptionButtonGDS.Value = True
            Me.OptionButtonSTAI.Value = True
            Me.OptionButtonZarit_Non.Value = True
            Me.OptionButtonNPI_Non.Value = True
            Me.OptionButtonCS_Non.Value = True
 
            With ActiveSheet
                .Rows("435:443").RowHeight = 12.75
                .Rows("445:446").RowHeight = 12.75
                .Rows("448:474").RowHeight = 12.75
                .Rows("496:515").RowHeight = 12.75
 
                L1 = .Range("K450").Left
                T1 = .Range("K450").Top
 
                Set Obj1 = .OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
                DisplayAsIcon:=False, Left:=L1, Top:=T1, Width:=120, Height:=20)
             End With
 
            With Obj1
                .Name = "Reduire_STAI"
                .PrintObject = False
                .Placement = 1
                .Object.Caption = "Réduire STAI"
                .Object.BackColor = RGB(219, 219, 219)
            End With
 
            Set Obj1 = Nothing
 
            Application.ScreenUpdating = True
 
      End If
 
End Sub

J'ai d'autres boutons mais qui font appel à des procédures placées dans des modules.
Je ne pense pas que le problème vienne d'elles.
Tout fonctionnait impeccable (le USF ne se fermait pas) avant cette tentative d'insertion de contrôle active x.