[débutant] Problème case

**thomaseude** · 01/04/2014, 07h07

Bonjour,

Je suis étudiant et je dois faire un projet vba

Je vous ai mis dessus le code de mon module vba excel
Seul le case me pose problème, sans ces case mon programme fonctionne mais évidement les boutons de ma msgboxperso ne sont pas relié
Je pense que le problème devrait pas être trop dure mais quand ça ne veut pas...ça ne veut pas

Choses à savoir :
Case 1 (= oui) --> ne m'affiche pas le résultat
Case 2 (=non) --> Ne m'affiche pas impossible
Case 3 (=je ne sais) --> m'affiche mon msgbox, Youpi!!

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
unction Prop1ZTest(X, n, P0, h1)
'h1 : 1:mu<m0 2:mu<>m0 3:mu>m0
 
 
t = (X - (n * P0)) / (Sqr(n * P0 * (1 - P0)))
'MsgBox ("Stat de test=" & T)
'Prop1ZTest = T
 
If n < 30 Then
vret = MsgBoxPerso(Prompt:="Le test suit-il une loi normale?", Title:="ATTENTION", Icon:=vQuestion, Buttons:="Oui|Non|Je ne sais pas")
Select Case vret
Case 1
If h1 = 2 Then
Prop1ZTest = 2 * normalCDF(t, 0, 1)
End If
If h1 = 1 Then
Prop1ZTest = normalCDF(t, 0, 1)
End If
If h1 = 3 Then
Prop1ZTest = 1 - normalCDF(t, 0, 1)
End If
 
Case 2
If h1 = 2 Then
Prop1ZTest = "impossible"
End If
If h1 = 1 Then
Prop1ZTest = "impossible "
End If
If h1 = 3 Then
Prop1ZTest = "impossible "
End If
 
Case 3
If h1 = 2 Then
Prop1ZTest = MsgBox("Ce référer à l'aide", , "Conseil")
End If
If h1 = 1 Then
Prop1ZTest = MsgBox("Ce référer à l'aide", , "Conseil")
End If
If h1 = 3 Then
Prop1ZTest = MsgBox("Ce référer à l'aide", , "Conseil")
End If
 
End Select
 
Else
If h1 = 2 Then
Prop1ZTest = 2 * normalCDF(t, 0, 1)
End If
If h1 = 1 Then
Prop1ZTest = normalCDF(t, 0, 1)
End If
If h1 = 3 Then
Prop1ZTest = 1 - normalCDF(t, 0, 1)
End If
 
End If
 
If n < X Then
Prop1ZTest = "impossible"
End If
 
If P0 < 0 Then
Prop1ZTest = "impossible"
End If
 
If P0 > 1 Then
Prop1ZTest = "impossible"
End If
 
If h1 < 1 Then
Prop1ZTest = "impossible"
End If
 
If h1 > 3 Then
Prop1ZTest = "impossible"
End If
 
 
End Function

Merci d'avance pour votre aide

**Gado2600** · 01/04/2014, 08h47

Bonjour,
Tout d'abord, bienvenue sur le forum !
Le premier truc que tu devrais indiquer dans ton post est : est-ce que tu arrives à entrer dans chacune de tes conditions case ? Cela on ne le sait pas.
As-tu bien définie ta variable "vret" ?
D'où vient la msgboxPerso ?

Cordialement,

**el_slapper** · 01/04/2014, 09h07

Sans vouloir être méchant, ton code est, euh, surprenant. Déjà, il faut indenter(avec la touche [TAB], par exemple) pour arriver à lire un peu :

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
Select Case vret
    Case 1
    If h1 = 2 Then
        Prop1ZTest = 2 * normalCDF(t, 0, 1)
    End If
    If h1 = 1 Then
        Prop1ZTest = normalCDF(t, 0, 1)
    End If
    If h1 = 3 Then
        Prop1ZTest = 1 - normalCDF(t, 0, 1)
    End If
 
Case 2
    If h1 = 2 Then
        Prop1ZTest = "impossible"
    End If
    If h1 = 1 Then
        Prop1ZTest = "impossible "
    End If
    If h1 = 3 Then
        Prop1ZTest = "impossible "
    End If
 
Case 3
    If h1 = 2 Then
        Prop1ZTest = MsgBox("Ce référer à l'aide", , "Conseil")
    End If
    If h1 = 1 Then
        Prop1ZTest = MsgBox("Ce référer à l'aide", , "Conseil")
    End If
    If h1 = 3 Then
        Prop1ZTest = MsgBox("Ce référer à l'aide", , "Conseil")
    End If
 
End Select

Bon, d'abord, il semble qu'il soit impossible pour h1 d'avoir une autre valeur que 1, 2 ou 3. Donc autant mettre un contrôle au début, du genre :

Code :

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

1
2
3
4
5
If (h1 = 1) Or (h1 = 2) Or (h1 = 3) Then
    (ton traitement)
Else
    Msgbox("Erreur sur h1 : " & h1)
End If

ensuite, tu as des duplications de code. En prenant en compte la remarque précédente, tu peux simplifier le code que je viens de réindenter en :

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
Select Case vret
    Case 1
    If h1 = 2 Then
        Prop1ZTest = 2 * normalCDF(t, 0, 1)
    End If
    If h1 = 1 Then
        Prop1ZTest = normalCDF(t, 0, 1)
    End If
    If h1 = 3 Then
        Prop1ZTest = 1 - normalCDF(t, 0, 1)
    End If
 
Case 2
    Prop1ZTest = "impossible"
 
Case 3
    Prop1ZTest = MsgBox("Se référer à l'aide", , "Conseil")
 
End Select

Mais ça ne répond pas vraiment à ta question. Comme nous n'avons pas tout ton classeur, tu vas devoir mettre un point d'arrêt(en cliquant dans la bande grise juste à gauche de ton code) sur la ligne du Select Case. Dans le menu "Affichage", selectionne l'affichage de la fenêtre des variables globales. Lance ton code qui doit marcher...et regarde, au moment ou tu arrives sur le Select, les valeurs de n, h1 mais surtout de vret. Il y a probablement des surprises à ce niveau-là; mais c'est à toi de les voir.

Ensuite, tu peux dérouler le code ligne par ligne avec [F8], ou le laisser repartir complètement avec [F5]. Ensuite, quand tu as trouvé quelle valeur ne correspond pas à tes attentes, tu peux remonter pour trouver l'erreur.

**thomaseude** · 01/04/2014, 20h02

Merci à vous pour vos réponses rapide

Oui, je dois avouer que ton indentation est beaucoup mieux
Je dois admettre que mon code est long pour finalement pas grand chose, néanmoins il marche...Du moins sur les ordinateurs de mon école mais malheureusement pas sur le mien. Je pense que le problème ne vient pas du code mais de ma msgboxperso qui bug.
En effet, ma msgboxperso s'exécute mais ne veut pas se fermer et n'affiche pas sur excel ce que je lui demande alors que comme je le disais cela fonctionne à mon école

A n'y rien comprendre

**Gado2600** · 02/04/2014, 08h50

Bonjour,
Je pense que pour t'aider sur ton problème, il faudra que tu mettes en pièce-jointe ton fichier Excel.
Actuellement, on ne sait pas ce quelle est la nature de ta msgboxPerso, la version d'Excel que tu utilises...
Cordialement,

**thomaseude** · 02/04/2014, 12h40

L'excel pour mon ordinateur c'est du excel 2010 et pour les ordinateurs de mon école c'est du excel 2007

Je dipose de 3 modules, dont voici les codes :

module 1 : code principale, code que je dois excécuter

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
Function Prop1ZTest(X, n, P0, h1)
'h1 : 1:mu<m0 2:mu<>m0 3:mu>m0
 
 
t = (X - (n * P0)) / (Sqr(n * P0 * (1 - P0)))
'MsgBox ("Stat de test=" & T)
'Prop1ZTest = T
 
If n < 30 Then
vret = MsgBoxPerso(Prompt:="Le test suit-il une loi normale?", Title:="ATTENTION", Icon:=vQuestion, Buttons:="Oui|Non|Je ne sais pas")
Select Case vret
  Case 1 'correspond au oui
    If h1 = 2 Then
       Prop1ZTest = 2 * normalCDF(t, 0, 1)
    End If
    If h1 = 1 Then
      Prop1ZTest = normalCDF(t, 0, 1)
    End If
    If h1 = 3 Then
       Prop1ZTest = 1 - normalCDF(t, 0, 1)
    End If
 
  Case 2 'correspond au non
    If h1 = 2 Then
      Prop1ZTest = "impossible"
    End If
   If h1 = 1 Then
     Prop1ZTest = "impossible "
   End If
   If h1 = 3 Then
     Prop1ZTest = "impossible "
   End If
 
  Case 3 'correspond au je ne sais pas
    If h1 = 2 Then
      Prop1ZTest = MsgBox("Se référer à la notice", , "Conseil")
    End If
   If h1 = 1 Then
     Prop1ZTest = MsgBox("Se référer à la notice", , "Conseil")
   End If
   If h1 = 3 Then
     Prop1ZTest = MsgBox("Se référer à la notice", , "Conseil")
   End If
 
End Select
 
Else
If h1 = 2 Then
Prop1ZTest = 2 * normalCDF(t, 0, 1)
End If
If h1 = 1 Then
Prop1ZTest = normalCDF(t, 0, 1)
End If
If h1 = 3 Then
Prop1ZTest = 1 - normalCDF(t, 0, 1)
End If
 
End If
 
If n < X Then
Prop1ZTest = "impossible"
End If
 
If P0 < 0 Then
Prop1ZTest = "impossible"
End If
 
If P0 > 1 Then
Prop1ZTest = "impossible"
End If
 
If h1 < 1 Then
Prop1ZTest = "impossible"
End If
 
If h1 > 3 Then
Prop1ZTest = "impossible"
End If
 
 
End Function

module 2 : le msgperso

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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
Option Explicit
Option Private Module
' <<<<< LE PRESENT MODULE DE CODE EST A INSERER DANS VOTRE PROJET TEL QUEL ! >>>>>
 
' ***************************************************************************************
' *                                                          ATTENTION!                                                             *
' *                                                                                                                                              *
' * Pour fonctionner, ce module nécessite que l'option "Faire confiance au projet *
' *           Visual Basic" soit cochée dans le menu Outils / Macro / Sécurité...            *
' ***************************************************************************************
 
'---------------------------------------------------------------------------------------
' Author    : Didier FOURGEOT (myDearFriend!)
' Date      : 02/11/2008
' Topic     : mDF MsgBoxPerso et boutons personnalisés
'---------------------------------------------------------------------------------------
 
' UTILISATION :
' -----------
' Dans votre code, vous ferez appel à la MsgBoxPerso comme vous le faites pour une MsgBox
' "classique", mais avec quelques arguments (optionnels) supplémentaires :
 
' SYNTAXE de la fonction :
' ----------------------
' R = MsgBoxPerso(Prompt, Title, Icon, Buttons, FontName, FontSize, FontStyle, txtAlign, X, Y)
 
' ARGUMENTS de la fonction :
' ------------------------
'   * Prompt:    Obligatoire. Il s'agit du texte de votre message.
'   * Title:     Facultatif. Titre de votre message.
'   * Icon:      Facultatif. Représente l'icône que vous voulez voir dans le message.
'                            Valeurs admises : 0 - vNoIcon (par défaut), 1 - vCritical,
'                                              2 - vQuestion, 3 - vExclamation ou
'                                              4 - vInformation.
'   * Buttons:   Facultatif. Chaîne de caractères représentant les libellés des boutons.
'                            Chaque bouton sera séparé par un caractère | (pipe).
'                            Pour définir le bouton qui aura le focus (bouton par défaut),
'                            faites suivre son libellé d'un caractère * (étoile).
'                            Exemple : Oui|Non*|Annuler
'                            ("Non" sera le bouton par défaut)
'   * FontName:  Facultatif. Chaîne de caractères représentant la police à utiliser pour le
'                            message. Exemple : "Arial"
'   * FontSize:  Facultatif. Valeur numérique pour la taille des caractères du message.
'                            Valeurs admises : de 0 à 72.
'   * FontStyle: Facultatif. Représente le style Normal, Gras ou Italic.
'                            Valeurs admises : 0 - vNormal (par défaut), 1 - vBold,
'                                              2 - vItalic ou 3 - vBoldItalic.
'   * TextAlign: Facultatif. Représente l'alignement du texte du message.
'                            Valeurs admises : 0 - vLeft (par défaut), 1 - vCenter ou
'                                              2 - vRight.
'   * X:         Facultatif. Valeur numérique représentant la coordonnée X du coin supérieur
'                            gauche de la boîte de dialogue.
'   * Y:         Facultatif. Valeur numérique représentant la coordonnée Y du coin supérieur
'                            gauche de la boîte de dialogue.
 
' RETOUR de la fonction :
' ---------------------
' Utilisée en tant que fonction, MsgBoxPerso retourne une valeur de type Integer correspondant
' au numéro d'ordre du bouton cliqué par l'utilisateur.
'
' EXEMPLE :
'
' Dim vRet As Integer
' vRet = MsgBoxPerso("Quel jour de la semaine ?", , , "Lundi|Mardi|Mercredi|Jeudi|Vendredi")
'
' Si l'utilisateur choisit "Jeudi", alors la fonction retournera la valeur 4.
 
' INFOS COMPLEMENTAIRES :
' ---------------------
' On peut aussi faire l'appel à l'aide des arguments nommés :
'   vRet = MsgBoxPerso(Prompt:="Etes-vous d'accord ?", Buttons:="Oui|Non|Sans avis")
'
' On peut aussi utiliser la macro comme méthode (sans retour de résultat) :
'   MsgBoxPerso "C'est fini !", , , "Ok"
 
' **************************************************************************************
 
' Déclaration des fonctions Api Windows pour récupération des Icônes de MsgBox
Public Declare Function FindWindowA& Lib "user32" (ByVal lpClassName$, ByVal lpWindowName$)
Public Declare Function GetDC& Lib "user32" (ByVal hwnd&)
Public Declare Function LoadIconA& Lib "user32" (ByVal hInstance&, ByVal lpIconName&)
Public Declare Function DrawIcon& Lib "user32" (ByVal Hdc&, ByVal X&, ByVal Y&, ByVal hIcon&)
Public Declare Function DestroyIcon& Lib "user32" (ByVal hIcon&)
' Pour les arguments nommés de la fonction
Public Enum StyleIcon
    vNoIcon
    vCritical
    vQuestion
    vExclamation
    vInformation
End Enum
Public Enum TextAlign
    vLeft
    vCenter
    vRight
End Enum
Public Enum StyleFont
    vNormal
    vBold
    vItalic
    vBoldItalic
End Enum
'Variable publique pour "capter" la réponse utilisateur
Public VmsgBoxValue
 
Function MsgBoxPerso(ByVal Prompt, Optional ByVal Title, Optional ByVal Icon As _
    StyleIcon = vNoIcon, Optional ByVal Buttons = "Ok", Optional ByVal FontName _
    = "Tahoma", Optional ByVal FontSize = 10, Optional ByVal FontStyle As StyleFont _
    = vNormal, Optional ByVal Align As TextAlign = vLeft, Optional ByVal X = 0, _
    Optional ByVal Y = 0) As Integer
Dim Btn
Dim Usf As Object, lblM As Object
Dim Icn As StyleIcon
Dim TestVbp$
Dim LngMaxB%, MargBtn%, Margin%
Dim i As Byte, xBtn As Byte
    'Test si "Faire confiance au projet VB" est coché
    On Error Resume Next
    TestVbp = ThisWorkbook.VBProject.Name
    On Error GoTo 0
    If TestVbp = vbNullString Then
        MsgBox "L'utilisation de la MsgBoxPerso nécessite que l'option" _
            & vbLf & """Faire confiance au projet Visual Basic"" soit cochée" _
            & vbLf & "dans menu Options / Macro / Sécurité...", _
            vbCritical, "mDF MsgBoxPerso..."
        MsgBoxPerso = 0
        Exit Function
    End If
    '
    Btn = Split(Buttons, "|")
    Icn = IIf(Icon < 1, 0, IIf(Icon > 4, 0, Icon + 32512))
    Margin = IIf(Icn > 0, 45, 0)
    FontStyle = Abs(Val(FontStyle))
    If FontStyle > 3 Then FontStyle = 0
    X = Abs(Val(X))
    Y = Abs(Val(Y))
    'Création du USF
    Set Usf = ThisWorkbook.VBProject.VBComponents.Add(3)
    'Title
    If IsMissing(Title) Then Title = Application.Name
    Usf.Properties("Caption") = Title
    Usf.Properties("StartUpPosition") = IIf(X + Y = 0, 1, 0)
    'Création zone de Prompt
    Set lblM = Usf.Designer.Controls.Add("Forms.Label.1")
    With lblM
        .Move 0, 15
        .WordWrap = False
        .Font.Size = Application.Min(Abs(Val(FontSize)), 72)
        .Font.Name = CStr(FontName)
        .TextAlign = IIf(Align < 0, 1, IIf(Align > 2, 1, Align + 1))
        .Font.Bold = FontStyle Mod 2 <> 0
        .Font.Italic = FontStyle > 1
        .AutoSize = True
        .Caption = Prompt
        .AutoSize = False
    End With
    'Création Buttons
    xBtn = 1    'Focus sur le premier bouton par défaut
    For i = 0 To UBound(Btn)
        With Usf.Designer.Controls.Add("Forms.CommandButton.1")
            .AutoSize = True
            .Caption = Application.Substitute(Btn(i), "*", "")
            LngMaxB = Application.Max(LngMaxB, .Width)
            .AutoSize = False
            'On mémorise le bouton désigné par défaut (terminé par *)
            If Right(Btn(i), 1) = "*" Then xBtn = i + 1
        End With
    Next i
    LngMaxB = Application.Max(LngMaxB, 50)
    'Placement des contrôles sur le USF et insertion du code VBA évènementiel
    With lblM
        Usf.Properties("Width") = Application.Max((LngMaxB + 10) * _
            (UBound(Btn) + 1) + 5, .Width + 24)
        Usf.Properties("Height") = 85 + .Height
        .Move Margin + 10, 15, Usf.Properties("Width") - 24, .Height
    End With
    With Usf
        MargBtn = (.Properties("Width") - (LngMaxB + 5) * (UBound(Btn) + 1))
        'Procédure UserForm_Activate()
        With .CodeModule
            .InsertLines .CountOfLines + 1, "Private Sub UserForm_Activate(): " _
                & "Dim hwnd&, hIcon&: DoEvents:" _
                & "hwnd = FindWindowA(vbNullString, Me.Caption):" _
                & "hIcon = LoadIconA(0&," & Icn & "):" _
                & "DrawIcon GetDC(hwnd), 26, 24, hIcon:" _
                & "DestroyIcon hIcon: Me.Controls(""CommandButton" & xBtn & """)" _
                & ".Setfocus:Beep:End Sub"
        End With
        For i = 0 To UBound(Btn)
            .Designer.Controls("CommandButton" & i + 1).Move Margin + MargBtn + _
                (LngMaxB + 5) * i, lblM.Top + lblM.Height + 22, LngMaxB, 20
            'Procédures évènementielles liées aux Buttons
            With .CodeModule
                .InsertLines .CountOfLines + 1, "Sub CommandButton" & i + 1 _
                    & "_Click():VmsgBoxValue =" & i + 1 & " :Unload Me:End Sub"
            End With
        Next i
        Usf.Properties("Width") = Usf.Properties("Width") + Margin
        'Interdire fermeture par la croix
        With Usf.CodeModule
            .InsertLines .CountOfLines + 1, "Private Sub UserForm_QueryClose(Cancel " _
                & "As Integer, CloseMode As Integer):Cancel = CloseMode = 0:End Sub"
        End With
        'Affichage la MsgBoxPerso, puis auto-destruction du USF
        If X + Y > 0 Then
            Usf.Properties("Left") = X
            Usf.Properties("top") = Y
        End If
        VBA.UserForms.Add(.Name).Show
    End With
    ThisWorkbook.VBProject.VBComponents.Remove Usf
    MsgBoxPerso = VmsgBoxValue
End Function

module 3 : Je l'utilise dans mon module 1

Code :

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

1
2
3
4
5
6
7
8
9
 
 
' Loi normal
 
Function normalCDF(X, mu, sigma)
normalCDF = WorksheetFunction.NormDist(X, mu, sigma, 1)
End Function
 
End Function

Je m'excuse pour l'intentation, j'ai un de mal avec ça

[débutant] Problème case

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager