Mise à jour combobox mais pas tous

**juju1988** · 08/10/2010, 16h46

Bonjour,

J'ai un petit problème à vous soumettre. Actuellement j'alimente 5 combobox par cette procédure :

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
Sub recupNumCmdTtt()
Dim i As Integer
Dim j As Byte
Dim NomCol As String
 
On Error GoTo errorValidation
'On efface au préalable les combobox pour ne pas avoir de doublons
With shAnalyse
    For j = 14 To 18
        NomCol = Left(.Cells(1, j).Address(0, 0), 1)
        .OLEObjects("cb" & NomCol & "40").Object.Clear
'On parcourt la ligne 37 et quand une cellule contient un numéro de commande on l'ajoute dans la combobox...
        .OLEObjects("cb" & NomCol & "40").Object.AddItem ""
        For i = cNumColonneDebutTableau To cNumColonneFinTableau
            If Cells(37, i).Value <> "" Then .OLEObjects("cb" & NomCol & "40").Object.AddItem .Cells(cNumLigneCmdTraitement, i)
        Next i
    Next j
End With
Exit Sub
 
errorValidation:
'Appelle la procédure qui envoit un mail à JFM en cas d'erreur
'Il faut récupérer : nom procédure, nom fichier, nom numéro lot, code erreur excel, description erreur
Call EnvoiMailErreurValidation("recupNumCmdTtt", wbkAnalyse.Name, Err.Number, Err.Description, wbkAnalyse.Path)
End Sub

Cependant si il y a une modification en ligne 37 il faut que je mette à jour ces combobox en rappellant ma procédure...

Ce que je fais de cette manière :

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col As String

Col = Left(Target.Address(0, 0), 1)

With shAnalyse
If InStr("N39_O39_P39_Q39_R39", Target.Address(0, 0)) > 0 Then
    .OLEObjects("cb" & Col & "40").Visible = Target.Value = "Sieving"
    If Target.Value = "" Then
        ActiveSheet.OLEObjects("cb" & Col & "40").Object.Value = ""
    End If
End If


If InStr("G37_J37_M37_N37_O37_P37_Q37_R37", Target.Address(0, 0)) > 0 Then
    Call recupNumCmdTtt
End If
End With

End Sub

Cependant si mon utilisateur a déjà tout sélectionné je ne veux pas que ça lui remette tout à zéro...

J'ai testé 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
26
27
28
29
30
31
32
33
34
35
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col As String
 
Col = Left(Target.Address(0, 0), 1)
 
With shAnalyse
If InStr("N39_O39_P39_Q39_R39", Target.Address(0, 0)) > 0 Then
    .OLEObjects("cb" & Col & "40").Visible = Target.Value = "Sieving"
    If Target.Value = "" Then
        ActiveSheet.OLEObjects("cb" & Col & "40").Object.Value = ""
    End If
End If
 
If InStr("G37_J37_M37_N37_O37_P37_Q37_R37", Target.Address(0, 0)) > 0 Then
    If Target.Address = "$G$37" Then
        .OLEObjects("cb" & Col & "40").Object.AddItem .Range("G37").Value
    ElseIf Target.Address = "$J$37" Then
        .OLEObjects("cb" & Col & "40").Object.AddItem .Range("J37").Value
    ElseIf Target.Address = "$M$37" Then
        .OLEObjects("cb" & Col & "40").Object.AddItem .Range("M37").Value
    ElseIf Target.Address = "$N$37" Then
        .OLEObjects("cb" & Col & "40").Object.AddItem .Range("N37").Value
    ElseIf Target.Address = "$O$37" Then
        .OLEObjects("cb" & Col & "40").Object.AddItem .Range("O37").Value
    ElseIf Target.Address = "$P$37" Then
        .OLEObjects("cb" & Col & "40").Object.AddItem .Range("P37").Value
    ElseIf Target.Address = "$Q$37" Then
        .OLEObjects("cb" & Col & "40").Object.AddItem .Range("Q37").Value
    ElseIf Target.Address = "$R$37" Then
        .OLEObjects("cb" & Col & "40").Object.AddItem .Range("R37").Value
    End If
End If
End With
 
End Sub

Cependant cela me fait une erreur de bloc with sur mon .OLEObject...
Si vous avez des idées.. je suis preneuse

**juju1988** · 11/10/2010, 09h16

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col As String
 
Col = Left(Target.Address(0, 0), 1)
 
With shAnalyse
If InStr("N39_O39_P39_Q39_R39", Target.Address(0, 0)) > 0 Then
    .OLEObjects("cb" & Col & "40").Visible = Target.Value = "Sieving"
    If Target.Value = "" Then
        ActiveSheet.OLEObjects("cb" & Col & "40").Object.Value = ""
    End If
End If
 
If InStr("G37_J37_M37_N37_O37_P37_Q37_R37", Target.Address(0, 0)) > 0 Then
    If Target.Address = "$G$37" Then
        cbN40.AddItem Range("G37").Value
        cbO40.AddItem Range("G37").Value
        cbP40.AddItem Range("G37").Value
        cbQ40.AddItem Range("G37").Value
        cbR40.AddItem Range("G37").Value
    ElseIf Target.Address = "$J$37" Then
        cbN40.AddItem Range("J37").Value
        cbO40.AddItem Range("J37").Value
        cbP40.AddItem Range("J37").Value
        cbQ40.AddItem Range("J37").Value
        cbR40.AddItem Range("J37").Value
    ElseIf Target.Address = "$M$37" Then
        cbN40.AddItem Range("M37").Value
        cbO40.AddItem Range("M37").Value
        cbP40.AddItem Range("M37").Value
        cbQ40.AddItem Range("M37").Value
        cbR40.AddItem Range("M37").Value
    ElseIf Target.Address = "$N$37" Then
        cbN40.AddItem Range("N37").Value
        cbO40.AddItem Range("N37").Value
        cbP40.AddItem Range("N37").Value
        cbQ40.AddItem Range("N37").Value
        cbR40.AddItem Range("N37").Value
    ElseIf Target.Address = "$O$37" Then
        cbN40.AddItem Range("O37").Value
        cbO40.AddItem Range("O37").Value
        cbP40.AddItem Range("O37").Value
        cbQ40.AddItem Range("O37").Value
        cbR40.AddItem Range("O37").Value
    ElseIf Target.Address = "$P$37" Then
        cbN40.AddItem Range("P37").Value
        cbO40.AddItem Range("P37").Value
        cbP40.AddItem Range("P37").Value
        cbQ40.AddItem Range("P37").Value
        cbR40.AddItem Range("P37").Value
    ElseIf Target.Address = "$Q$37" Then
        cbN40.AddItem Range("Q37").Value
        cbO40.AddItem Range("Q37").Value
        cbP40.AddItem Range("Q37").Value
        cbQ40.AddItem Range("Q37").Value
        cbR40.AddItem Range("Q37").Value
    ElseIf Target.Address = "$R$37" Then
        cbN40.AddItem Range("R37").Value
        cbO40.AddItem Range("R37").Value
        cbP40.AddItem Range("R37").Value
        cbQ40.AddItem Range("R37").Value
        cbR40.AddItem Range("R37").Value
    End If
End If
End With
 
End Sub

J'ai testé de cette manière mais même erreur, je ne sais plus comment faire...

**juju1988** · 11/10/2010, 09h33

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col As String
 
Col = Left(Target.Address(0, 0), 1)
 
If InStr("N39_O39_P39_Q39_R39", Target.Address(0, 0)) > 0 Then
    ActiveSheet.OLEObjects("cb" & Col & "40").Visible = Target.Value = "Sieving"
    If Target.Value = "" Then
        ActiveSheet.OLEObjects("cb" & Col & "40").Object.Value = ""
    End If
End If
 
If InStr("G37_J37_M37_N37_O37_P37_Q37_R37", Target.Address(0, 0)) > 0 Then
    If Target.Address = "$G$37" Then
        cbN40.AddItem Range("G37").Value
        cbO40.AddItem Range("G37").Value
        cbP40.AddItem Range("G37").Value
        cbQ40.AddItem Range("G37").Value
        cbR40.AddItem Range("G37").Value
    ElseIf Target.Address = "$J$37" Then
        cbN40.AddItem Range("J37").Value
        cbO40.AddItem Range("J37").Value
        cbP40.AddItem Range("J37").Value
        cbQ40.AddItem Range("J37").Value
        cbR40.AddItem Range("J37").Value
    ElseIf Target.Address = "$M$37" Then
        cbN40.AddItem Range("M37").Value
        cbO40.AddItem Range("M37").Value
        cbP40.AddItem Range("M37").Value
        cbQ40.AddItem Range("M37").Value
        cbR40.AddItem Range("M37").Value
    ElseIf Target.Address = "$N$37" Then
        cbN40.AddItem Range("N37").Value
        cbO40.AddItem Range("N37").Value
        cbP40.AddItem Range("N37").Value
        cbQ40.AddItem Range("N37").Value
        cbR40.AddItem Range("N37").Value
    ElseIf Target.Address = "$O$37" Then
        cbN40.AddItem Range("O37").Value
        cbO40.AddItem Range("O37").Value
        cbP40.AddItem Range("O37").Value
        cbQ40.AddItem Range("O37").Value
        cbR40.AddItem Range("O37").Value
    ElseIf Target.Address = "$P$37" Then
        cbN40.AddItem Range("P37").Value
        cbO40.AddItem Range("P37").Value
        cbP40.AddItem Range("P37").Value
        cbQ40.AddItem Range("P37").Value
        cbR40.AddItem Range("P37").Value
    ElseIf Target.Address = "$Q$37" Then
        cbN40.AddItem Range("Q37").Value
        cbO40.AddItem Range("Q37").Value
        cbP40.AddItem Range("Q37").Value
        cbQ40.AddItem Range("Q37").Value
        cbR40.AddItem Range("Q37").Value
    ElseIf Target.Address = "$R$37" Then
        cbN40.AddItem Range("R37").Value
        cbO40.AddItem Range("R37").Value
        cbP40.AddItem Range("R37").Value
        cbQ40.AddItem Range("R37").Value
        cbR40.AddItem Range("R37").Value
    End If
End If
 
'Call recupNumCmdTtt
End Sub

Voici la solution qui fonctionne...

**mercatog** · 11/10/2010, 14h14

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col As String
 
Col = Left(Target.Address(0, 0), 1)
 
If InStr("N39_O39_P39_Q39_R39", Target.Address(0, 0)) > 0 Then
    ActiveSheet.OLEObjects("cb" & Col & "40").Visible = Target.Value = "Sieving"
    If Target.Value = "" Then ActiveSheet.OLEObjects("cb" & Col & "40").Object.Value = ""
End If
 
If InStr("G37_J37_M37_N37_O37_P37_Q37_R37", Target.Address(0, 0)) > 0 Then
    If Target.Value <> "" Then
        cbN40.AddItem Target.Value
        cbO40.AddItem Target.Value
        cbP40.AddItem Target.Value
        cbQ40.AddItem Target.Value
        cbR40.AddItem Target.Value
    End If
End If
End Sub

Suffit

**juju1988** · 11/10/2010, 14h33

Ok merci

Mise à jour combobox mais pas tous [XL-2003]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager