Problème de code. Mais où est donc l'erreur ?

**Novice72** · 01/07/2018, 12h36

Bonjour à toutes et à tous,

J'ai, grâce à vous, un bout de code qui fonctionne très bien. Le but de ce code ( qui peut être récupéré par certains d'entre vous bien au contraire ) est expliqué ici :
Lorsque je choisis un département proposé par la ComboBox1, la liste des villes proposées dans la ComboBox2 correspond aux villes du département sélectionné. Puis, lorsque je choisis une ville, la ComboBox3 me propose tous les lycées de cette ville ( et je sélectionne celui que je veux....).
Si je décide de faire un autre choix pour la comboBox1, les 2 autres ComboBox se vident donc c'est bien.
Voici donc mon problème :
J'ai repris tout ce code et je l'ai adapté comme suit :
ComboBox1 ( elle me permet de choisir si l'examen final est le CAP ou le BAC PRO ) donc 2 choix possibles.
En fonction de ce choix :
ComboBox2 ( elle me propose toutes les classes de BAC PRO ou toutes les classes de CAP ) suivant la sélection précédente.
La ComboBox3 ( suivant la classe ) me propose L'intitulé de l'Examen ou non ( Evaluation pour toutes les classes, Diplôme intermédiaire pour les Première BAC PRO qui peut être soit CAP soit BEP suivant section et le CAP "pur" pour les classes de CAP et le BAC PRO pour les Terminales BAC PRO ). Bref, pas très simple à expliquer par écrit....

Ici, lorsque je décide de faire un autre choix pour la comboBox1, les 2 autres ComboBox ne se vident pas ou lorsque je change de choix pour la ComboBox2, de même, la ComboBox3 ne se vide pas.......
Ci-dessous les deux codes :

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
 
 
Option Explicit
Dim var As Variant  'variable déclarée au sequence module
Private Sub Departement_Enter()
Dim i&
Dim varTab As Variant
'---
Departement.Clear
Ville.Clear
Lycee.Clear
'---
Departement.List = GetList(ColSearch:=3)
End Sub
Private Sub Ville_Enter()
Dim i&
Dim varTab As Variant
'---
Ville.Clear
Lycee.Clear
If Departement = "" Then Exit Sub
'---
On Error Resume Next
Ville.List = GetList(ColSearch:=2, Filtre:=Departement, ReferToCol:=3)
End Sub
Private Sub Lycee_Enter()
Dim i As Integer
Dim varTab As Variant
'---
Lycee.Clear
If Ville = "" Then Exit Sub
'---
On Error Resume Next
Lycee.List = GetList(ColSearch:=1, Filtre:=Ville, ReferToCol:=2)
End Sub
Private Sub UserForm_Initialize()
  Sheets("Programmation").Select
  Range("A1:A60").Select
  Selection.ClearContents
  Sheets("Elèves").Select
  Range("A1:CY1").Select
  Selection.ClearContents
  Sheets("CD").Select
  Range("A2:Z100").Select
  Selection.ClearContents
 
Range("A1").Select
'### On stocke toute la feuille Base de données dans un Variant ###
'###   de portée Module (voir tout en haut Dim var As Variant)  ###
Dim r As Range
Set r = Sheets("DVL").[A1].CurrentRegion
var = r
End Sub
Private Sub Ok_Click()
Dim nomlp As String
Application.ScreenUpdating = False
Worksheets("programmation").Activate
Range("G1") = Lycee.Value
Range("H1") = Ville.Value
Range(Cells(1, 1), Cells(60, 1)).Select
Selection.Clear
Range("H1").Select
     nomlp = Range("G1")
     Select Case nomlp    ' <= la valeur à tester
     Case Is = Worksheets("DVL").Range("A2")             ' <= si Arcisse de Caumont
        caumont.Show
     Case Is = Worksheets("DVL").Range("A3")             ' <= si Institut Lemonnier
        Lemonnier.Show
     Case Is = Worksheets("DVL").Range("A4")             ' <= si L' Oasis
        Oasis.Show
' j'ai coupé la listé...
     Case Is = Worksheets("DVL").Range("A52")             ' <= si Flora Tristan
        Tristan.Show
     Case Is = Worksheets("DVL").Range("A53")             ' <= si Jean Monnet
        Monnet.Show
     Case Else           ' <= si la valeur n'est égale à aucune des valeurs ci-dessus
        MsgBox "Vous avez fait une erreur"
     End Select
Worksheets("Grille chronologique").Activate
Unload Me
End Sub
'############################################################################################
'### La fonction GetList recherche les éléments sans doublon et triés par ordre croissant ###
'### et retourne un Variant Tableau                                                       ###
'###                                                                                      ###
'### Les arguments :                                                                      ###
'### ColSearch  : N° de colonne de la base de données dont les éléments seront affichés   ###
'###              dans la liste de la ComboBox                                            ###
'### Filtre     : La valeur de la ComboBox Parent qui filtre les éléments correspondants  ###
'### ReferToCol : N° de colonne du filtre                                                 ###
'############################################################################################
Private Function GetList(ColSearch As Long, Optional Filtre As Variant, Optional ReferToCol As Long) As Variant
Dim SL As Object
Dim i&
Dim T()
'---
Set SL = CreateObject("System.Collections.SortedList")
On Error Resume Next
For i& = 2 To UBound(var, 1)    'on part de la ligne 2 pour omettre la ligne de titres
  If IsMissing(Filtre) Then
    SL.Add var(i&, ColSearch), var(i&, ColSearch)
  Else
    If var(i&, ReferToCol) = Filtre Then
      SL.Add var(i&, ColSearch), var(i&, ColSearch)
    End If
  End If
Next i&
On Error GoTo 0
'---
If SL.Count > 0 Then
  ReDim T(1 To SL.Count)
  For i& = 0 To SL.Count - 1
    T(i& + 1) = SL.GetKey(i&)
  Next i&
  GetList = T
End If
End Function

L'autre code qui a le problème :

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
 
Private Sub ExamenFinal_Enter()
Dim i&
Dim varTab As Variant
'---
ExamenFinal.Clear
Classes.Clear
ExamenouEvaluation.Clear
'---
ExamenFinal.List = GetList(ColSearch:=4)
End Sub
Private Sub Classes_Enter()
Dim i&
Dim varTab As Variant
'---
Classes.Clear
ExamenouEvaluation.Clear
If ExamenFinal = "" Then Exit Sub
'---
On Error Resume Next
Classes.List = GetList(ColSearch:=3, Filtre:=ExamenFinal, ReferToCol:=4)
End Sub
Private Sub ExamenouEvaluation_Enter()
Dim i As Integer
Dim varTab As Variant
'---
ExamenouEvaluation.Clear
If Classes = "" Then Exit Sub
'---
On Error Resume Next
ExamenouEvaluation.List = GetList(ColSearch:=2, Filtre:=Classes, ReferToCol:=3)
End Sub
'############################################################################################
'### La fonction GetList recherche les éléments sans doublon et triés par ordre croissant ###
'### et retourne un Variant Tableau                                                       ###
'###                                                                                      ###
'### Les arguments :                                                                      ###
'### ColSearch  : N° de colonne de la base de données dont les éléments seront affichés   ###
'###              dans la liste de la ComboBox                                            ###
'### Filtre     : La valeur de la ComboBox Parent qui filtre les éléments correspondants  ###
'### ReferToCol : N° de colonne du filtre                                                 ###
'############################################################################################
Private Function GetList(ColSearch As Long, Optional Filtre As Variant, Optional ReferToCol As Long) As Variant
Dim SL As Object
Dim i&
Dim T()
'---
Set SL = CreateObject("System.Collections.SortedList")
On Error Resume Next
For i& = 2 To UBound(var, 1)    'on part de la ligne 2 pour omettre la ligne de titres
  If IsMissing(Filtre) Then
    SL.Add var(i&, ColSearch), var(i&, ColSearch)
  Else
    If var(i&, ReferToCol) = Filtre Then
      SL.Add var(i&, ColSearch), var(i&, ColSearch)
    End If
  End If
Next i&
On Error GoTo 0
'---
If SL.Count > 0 Then
  ReDim T(1 To SL.Count)
  For i& = 0 To SL.Count - 1
    T(i& + 1) = SL.GetKey(i&)
  Next i&
  GetList = T
End If
End Function

Je vous remercie d'avance.

Novice72

**patricktoulon** · 01/07/2018, 13h21

re
bonjour
je supose que tes listes sont issues d'un sheets

on pourrait avoir ce sheets ??

**Novice72** · 01/07/2018, 14h42

Envoyé par patricktoulon

re
bonjour
je supose que tes listes sont issues d'un sheets

on pourrait avoir ce sheets ??

rebonjour Patrick

Je t'envoie, comme demandé, mon fichier afin que tu voies les 2 sheets ( Feuille DVL pour Département/Ville/Lycée là ça fonctionne ) et ( Feuille CD pour Classe/Diplome ).

Le programme ne peut fonctionner car il était beaucoup trop lourd ( 13Mo ). J'ai supprimé des feuilles et userforms non utile pour résoudre mon problème.

Encore Merci

Novice72

**Novice72** · 04/07/2018, 22h04

Bonjour,

J'essaie toujours de comprendre d'où vient l'erreur de code. Pour cela, quelqu'un peut-il me dire ce que signifie la ligne suivante ?

Code :

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

1
2
 
Set r = Sheets("CD").[A1].CurrentRegion

Je comprends que c'est une plage de la feuille "CD". mais que signifie notamment les crochets autour de A1 ?

Encore merci pour votre aide.

Novice72

**clementmarcotte** · 05/07/2018, 00h59

Bonjour,

En fait, les crochets sont un vieux raccourci pour la fonction Evaluate. Dans ce cas, il s'agit plutôt d'une tricherie. La fonction Evaluate oblige Excel à se rendre sur la plage en question qui est la région qui contient a1.

Problème de code. Mais où est donc l'erreur ?

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager