Discussion :

[rocofolie]

Bonjour ,

Je cherche a remplacer la fonction INDIRECT par du VBA, car je vais avoir beaucoup de condition a écrire mais je ne sais pas trop comment m'y prendre

Sur le fichier joint, j'aimerai que par exemple si je choisis en (C2) "63A" j'aimerai que la selection en (E2) n'autorise que les choix de 16mm² a 150mm²

J'aimerai ecrire si possible quelque chose dans ce style :
If Range("C2") = "63A" Then Range ("E2") .......

Ma traduction serait si on choisit le calibre "63A" en C2 alors E2 ne peut etre égale qu'a 16mm² ou 50mm² ou 70mm²A ou 150mm²

De meme j'aimerai que Si B2 = "BORNIER_MONO" alors B3 ne contiennt pas de ligne de choix contenant le texte "TETRA"

Mais ca se sont mes besoins , est ce faisable ?

Sachant que j'ai un paquet de condition a ecrire.

Merci

[boisgontierjacques]

Bonjour,

Exemple en PJ de liste en cascade avec BD (sans indirect())

Jacques Boisgontier

[PMO2017]

Bonjour,

C'est faisable en VBA, je suis arrivé à faire un exemple qui fonctionne.
Cependant, vous allez peut être fuir devant :
1) la complexité du code, difficile à comprendre bien que je l'ai documenté du mieux que j'ai pu
2) la nécessité de faire une refonte complète de la feuille base de données
*****
Il y a 2 feuilles (DEVIS et BD) dont les colonnes sont ordonnées de même manière.
On peut adjoindre d'autres colonnes (par exemple Qté, TOTAL, etc) à la feuille DEVIS en prenant soin de conserver les premières colonnes correspondant à celles de la feuille BD.
Excel est limité à la seule option tabulaire d'une base de données, il faut donc construire la base de données en renseignant systématiquement tous ses champs. On dispose de beaucoup de lignes pour ce faire.
Référez-vous au classeur exemple ci-joint.
*****
Tout commence par l'évènement Worksheet_SelectionChange qui, selon le cas, lance la construction dynamique d'un DropDown dans lequel un choix peut être effectué.
Voilà les différents codes

1) code à copier dans la fenêtre de code de la feuille DEVIS

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call DelDropDown
With Target
  If .Column > COLONNES_VALIDES Then Exit Sub             'si colonne non valide, on sort
  If .Row = 1 Then Exit Sub                               'si c'est la ligne de titres, on sort
  If .Rows.Count > 1 Or .Columns.Count > 1 Then Exit Sub  'si c'est plus d'une cellule, on sort
 
  If .Value <> "" Then Exit Sub   'Si la cellule est déjà renseignée, on sort
                                  'Mettre rien dans la cellule pour réactiver l'action
End With
Call AddListe(Target)
End Sub

2) code à copier dans un module Standard

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
'### Constantes à adapter à votre usage ###
Private Const BASE_DONNEES As String = "BD" 'nom de la feuille contenant la base de données
Public Const COLONNES_VALIDES As Long = 5   'nombre de colonnes où agissent les listes (DropDown)
'##########################################
 
Sub AddListe(R As Range)
Dim numCol&
Dim numLig&
Dim lastLig&
Dim i&
Dim j&
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim R2 As Range
Dim SH As Shape
Dim DD As DropDown
Dim var
Dim ChoixAvant As String
Dim A$
Dim col_Articles As New Collection
Dim T()
'--- Qui nous appelle ? ---
Set S1 = R.Parent   'feuille appelante
numCol& = R.Column  'colonne appelante
numLig& = R.Row     'ligne appelante
'--- Feuille base de données ---
Set S2 = ThisWorkbook.Sheets(BASE_DONNEES)
lastLig& = S2.[a65536].End(xlUp).Row  'dernière ligne renseignée
 
'### La colonne A ###
If numCol& = 1 Then
  '--- Données de la colonne A ---
  Set R2 = S2.Range(S2.Cells(2, numCol&), S2.Cells(lastLig&, numCol&))
  var = R2  'on met le Range dans un Variant qui se comporte comme un tableau bidimensionnée (x lignes, 1 
 
colonne)
  '--- On utilise une Collection sans doublon ---
  On Error Resume Next
  For i& = LBound(var, 1) To UBound(var, 1)
    col_Articles.Add (var(i&, 1)), CStr(var(i&, 1))
  Next i&
  Err.Clear
  On Error GoTo 0
 
'### Colonne différente de la colonne A ###
Else
  '/// Feuille appelante ///
  '--- La colonne précédente est-elle renseignée ? ---
  ChoixAvant = CStr(R.Offset(0, -1))
  If ChoixAvant = "" Then Exit Sub         'on sort si elle ne l'est pas
  '--- Chaîne de référence des choix des colonnes avant la colonne appelante ---
  ChoixAvant = ""
  For j& = 1 To numCol& - 1
    ChoixAvant = ChoixAvant & CStr(S1.Cells(numLig&, j&))
  Next j&
 
  '/// Feuille de la base de données ///
  '--- Données de la colonne A jusqu'à numCol& ---
  Set R2 = S2.Range(S2.Cells(2, 1), S2.Cells(lastLig&, numCol&))
  var = R2  'on met le Range dans un Variant qui se comporte comme un tableau bidimensionnée (x lignes, 
 
numCol&)
  '--- On utilise une Collection sans doublon ---
  On Error Resume Next
  For i& = LBound(var, 1) To UBound(var, 1)
    '--- Chaîne des colonnes avant la colonne numCol& ---
    A$ = ""
    For j& = 1 To numCol& - 1
      A$ = A$ & CStr(var(i&, j&))
    Next j&
    '--- Correspondance avec les choix des colonnes précédentes ---
    If A$ = ChoixAvant Then
      col_Articles.Add (var(i&, numCol&)), CStr(var(i&, numCol&))
    End If
  Next i&
  On Error GoTo 0
End If
 
'### DropDown dynamique ###
'--- Création d'une Shape ---
Set SH = S1.Shapes.AddFormControl(xlDropDown, R.Left, R.Top, R.Width, R.Height)
SH.OnAction = "DropDownSurClic"
SH.Name = "___pmo"
'--- Récupération du réel objet DropDown ---
Set DD = SH.OLEFormat.Object
DD.DropDownLines = 12
'--- Mise en tableau de la Collection ---
ReDim T(1 To col_Articles.Count)
For i& = 1 To col_Articles.Count
  T(i&) = col_Articles.Item(i&)
Next i&
'--- Affichage des items dans le DropDown ---
If UBound(T, 1) = 1 Then
  DD.AddItem T(1)
Else
  DD.List = T
End If
'--- Sélection du Range appelant ---
R.Select
End Sub
 
Sub DropDownSurClic()   '### Evènement Clic sur le DropDown ###
Dim SH As Shape
Dim DD As DropDown
Dim S As Worksheet
Dim R As Range
Dim i&
Dim j&
'--- Recherche du DropDown ---
For Each SH In ActiveSheet.Shapes
  If SH.FormControlType = xlDropDown Then
    Set DD = SH.OLEFormat.Object
    Exit For
  End If
Next SH
'--- Inscription de la sélection du DropDown ---
Set R = ActiveCell
Set S = R.Parent
R = DD.List(DD)
'--- Si les colonnes après sont déjà renseignées, on les efface ---
If R.Column < COLONNES_VALIDES Then
  Set R = S.Range(S.Cells(R.Row, R.Column + 1), S.Cells(R.Row, COLONNES_VALIDES))
  R = ""
End If
'--- Destruction du DropDown ---
Call DelDropDown
End Sub
 
Sub DelDropDown(Optional dummy As Byte) '### Destruction du DropDown ###
Dim SH As Shape
On Error Resume Next
For Each SH In ActiveSheet.Shapes
  If SH.FormControlType = xlDropDown Then
    If SH.Name = "___pmo" Then SH.Cut
  End If
Next SH
End Sub

3) pour la refonte de la feuille base de données (BD) et l'organisation des colonnes de la feuille DEVIS, consutez l'exemple joint.

A tous ceux qui s'intéresseront, pouvez-vous me dire si vous avez pu adapter sans trop de difficulté selon votre besoin ?
Autant j'ai pris plaisir à programmer cette piste, autant il m'est rébarbatif et besogneux d'en apporter commentaires et explications.
De cela j'aimerais me passer si personne n'y a trouvé un intérêt quelconque. J'attends donc vos avis.

[rocofolie]

Merci beaucoup pour vos réponse.

En effet il faut que je prenne bien le temps de me pencher dessus pour comprendre le code et voir la refonte de la BDD .

En tous cas un grand merci pour le boulot !
Et je comprend qu'il soit compliqué d'expliquer pas a pas , les commentaires inscrits me permettent déjà de comprendre la démarche.

Une dernière question , vu mon faible niveau voir nul en VBA , je cherche a utiliser la fonction "OU" , je pensais pouvoir faire chaque cas comme ceci :

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
'Calibre 160A
    If InStr(calibre, "160") > 0 And InStr(liaisonbornier, "150") > 0 Then
        Range("E2").Interior.Color = RGB(255, 255, 255)
            Else: Range("E2").Interior.Color = RGB(237, 0, 0)
    End If
Or
    If InStr(calibre, "160") > 0 And InStr(liaisonbornier, "120") > 0 Then
        Range("E2").Interior.Color = RGB(255, 255, 255)
            Else: Range("E2").Interior.Color = RGB(237, 0, 0)
    End If
Or
    If InStr(calibre, "160") > 0 And InStr(liaisonbornier, "95") > 0 Then
        Range("E2").Interior.Color = RGB(255, 255, 255)
           'Else: Range("E2").Interior.Color = RGB(237, 0, 0)
    End If
Or
    If InStr(calibre, "160") > 0 And InStr(liaisonbornier, "70") > 0 Then
       Range("E2").Interior.Color = RGB(255, 255, 255)
            Else: Range("E2").Interior.Color = RGB(237, 0, 0)
    End If
Or
    If InStr(calibre, "160") > 0 And InStr(liaisonbornier, "50") > 0 Then
        'Range("E2").Interior.Color = RGB(255, 255, 255)
            'Else: Range("E2").Interior.Color = RGB(237, 0, 0)
    End If

Mais je ne sais pas comment m y prendre.

Merci encore.