Discussion :

[brahimich]

Bonsoir,

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
Sub Interpretation()
 
    If box_mesure = "- de 1,70 M" And box_cheveux = "BRUN-NOIR" And box_yeux = "NOISETTE" And box_age = "22 ANS" Then
        'aller sur la bonne feuille
        Sheets("BENJI").Select
    End If
 
    If box_mesure = "=  1,75 M" And box_cheveux = "BRUN-NOIR" And box_yeux = "BLEU" And box_age = "28 ANS" Then
        'aller sur la bonne feuille
        Sheets("FLORENT").Select
    End If
 
    If box_mesure = "+ de 1,80 M" And box_cheveux = "CHATAIN" And box_yeux = "VERT" And box_age = "21 ANS" Then
        'aller sur la bonne feuille
        Sheets("RAPHAEL").Select
    End If

Je vous explique :

En fait j'ai un questionnaire à choix multiple qui m'envoie, quand je choisi certaines réponses, sur une page demandée.
J'aimerais, car j'ai 4 questions et 12 choix différents de réponses, avoir un code qui, si je ne choisis pas l'une des réponses d'au dessus, m'envoie sur une autre page qui serait comme une "page d'erreur' pour dire que c'est un mauvais choix. Comme ca je n'aurais pas à recopier plus d'une quarantaine de fois chaque code pour chaque valeur...

Merci

[francis60]

Bonjour Brahimich,

Puisque tous tes tests sont exclusifs les uns des autres, tu peux utiliser ElseIf qui permet d'imbriquer les conditions, bien que cette pratique appartienne pas à la programmation structurée stricte.

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
Sub Interpretation()
 
    If box_mesure = "- de 1,70 M" And box_cheveux = "BRUN-NOIR" And box_yeux = "NOISETTE" And box_age = "22 ANS" Then
        'aller sur la bonne feuille
        Sheets("BENJI").Select
 
    ElseIf box_mesure = "=  1,75 M" And box_cheveux = "BRUN-NOIR" And box_yeux = "BLEU" And box_age = "28 ANS" Then
        'aller sur la bonne feuille
        Sheets("FLORENT").Select
 
    ElseIf box_mesure = "+ de 1,80 M" And box_cheveux = "CHATAIN" And box_yeux = "VERT" And box_age = "21 ANS" Then
        'aller sur la bonne feuille
        Sheets("RAPHAEL").Select
 
    Else
        'aller sur la feuille d'erreur
        Sheets("page d'erreur").Select
 
    End If
 
End Sub

Si tu dois créer QCM très long, pour éviter un code trop long à écrire et difficile à maintenir, il faudrait plutôt créer une routine d'évaluation basée sur une tableau de réponses.

Veille aussi à donner un nom plus précis lorsque tu postes, tu auras plus de réponses et surtout plus vite.

Cordialement,
Francis

[brahimich]

Bonsoir Francis60,

Tout d'abord merci pour le code car il fonctionne parfaitement pour ma page. Par contre, si j'essaie de l'étendre à une seconde page avec la même forme de questionnaire mais avec des données différentes et il ne prend pas en compte la modifications des données mais prend toujours en compte les anciennes données... Est ce normal ?

Auriez vous le lien d'un tutoriel pour le tableau à base de réponse ?

Je ne savais pas quoi poser comme titre ... Mais merci du conseil j'y réfléchirai plus la prochaine fois !

Bien cordialement,

[francis60]

Brahimich,

Tu peut faire un tableau de ce genre dans une feuille cachée (Visible = xlSheetVeryHidden):

mesure	cheveux	yeux	age	feuille
- de 1,70 M	BRUN-NOIR	NOISETTE	22 ANS	BENJI
1,75 M	BRUN-NOIR	NOISETTE	28 ANS	FLORENT
+ de 1,80 M	BRUN-NOIR	NOISETTE	22 ANS	RAPHAEL

Puis créer un fonction qui retourne le nom de la feuille à afficher:

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
Option Explicit
 
Dim Reponses As Variant
 
Sub Test()
'Pour tester la routine d'évaluation sur la ligne N° 1:
 
     MsgBox "Exemple 1 : " & Reponse("- de 1,70 M", "BRUN-NOIR", "NOISETTE", "22 ANS")
 
End Sub
 
Function Reponse(mesure_ As String, cheveux As String, yeux As String, age As String) As String
 
    'Ton code pour évaluer la réponse
    Call ChargerTableau
    '...
 
    'Reponse = NomDeLaFeuille ou "page erreur" :
    Reponse = Reponses(1, 5)        'exemple
 
End Function
 
Sub ChargerTableau()
Dim DataRange As Range
 
    Set DataRange = ThisWorkbook.Worksheets("FeuilleCachee").Range("A2:E4")
    Reponses = DataRange
 
End Sub

Quelque liens pour l'utilisation des tableaux:
http://silkyroad.developpez.com/vba/tableaux/

On peut aussi saisir un tableau à l'intérieur du code pour qu'il reste complètement inaccessible mais c'est moins pratique que dans une feuille Excel.

Voilà qui devrait t'aider à progresser si tu veux bien investir du temps et du travail sur ce sujet.

Cordialement,
Francis

[brahimich]

Bonjour,

Tout d'abord désolée pour la lenteur de ma réponse, j'avais mis VBA de côté pour quelques temps !

Je ne comprends pas ce que tu essaies de m'expliquer car dans ton code je ne sais pas ce que je dois remplacer et si je dois mettre plusieurs Msg Box. J'essaye de t'envoyer mon projet en pièce jointe mais je n'y arrive pas ...

Cordialement,

[francis60]

Brahimich,

La sub Test() qui contient le MsgBox sert juste à illustrer le fonctionnement de la function Reponse().
L'avantage de créer une fonction c'est que tu n'as pas à recopier le code à chaque utilisation.

Cordialement,

[brahimich]

Bonsoir,

dans quel page dois je mettre ce code pour qu'il fonctionne ?

Cordialement

[brahimich]

J'ai fini mon projet, je vous remercie donc pour votre aide, cela m'a beaucoup servi!!!!
Bien cordialement,