Microsoft 365 Problème pour mettre plusieurs code VBA sur la même feuille pour contrôler plusieurs combobox

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

fredzertya

XLDnaute Nouveau
Bonjour,


Je suis débutant en VBA, et me trouve devant un problème, sur une feuille il y a plusieurs combobox l'idée et d'avoir une saisie intuitif sur les combox, j'ai un code qui fonctionne bien sur la combobox1, que je voudrais reproduire légèrement modifier pour les autres combobox de la feuille, et là problème, je ne sais pas comment faire, pour avoir plusieurs code sur la même feuille.

Merci par avance.


____________________________________________________________________________________________________
1er code sur la feuille

Dim a()
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect([C14:C14], Target) Is Nothing And Target.Count = 1 Then
Set f = Sheets("BD")
a = Application.Transpose(f.Range("L1:L" & f.[A65000].End(xlUp).Row))
Me.ComboBox1.List = a
Me.ComboBox1.Height = Target.Height + 3
Me.ComboBox1.Width = Target.Width
Me.ComboBox1.Top = Target.Top
Me.ComboBox1.Left = Target.Left
Me.ComboBox1 = Target
Me.ComboBox1.Visible = True
Me.ComboBox1.Activate
Else
Me.ComboBox1.Visible = False
End If
End Sub
Private Sub ComboBox1_Change()
If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
Me.ComboBox1.List = Filter(a, Me.ComboBox1.Text, True, vbTextCompare)
Me.ComboBox1.DropDown
End If
ActiveCell.Value = Me.ComboBox1
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.ComboBox1.List = a
Me.ComboBox1.Activate
Me.ComboBox1.DropDown
End Sub

___________________________________________________________________________________________________
2eme code sur la même feuille

Dim a()
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect([C16:C16], Target) Is Nothing And Target.Count = 1 Then
Set f = Sheets("BDD")
a = Application.Transpose(f.Range("B5:B" & f.[A65000].End(xlUp).Row))
Me.ComboBox2.List = a
Me.ComboBox2.Height = Target.Height + 3
Me.ComboBox2.Width = Target.Width
Me.ComboBox2.Top = Target.Top
Me.ComboBox2.Left = Target.Left
Me.ComboBox2 = Target
Me.ComboBox2.Visible = True
Me.ComboBox2.Activate
Else
Me.ComboBox2.Visible = False
End If
End Sub
Private Sub ComboBox2_Change()
If Me.ComboBox2 <> "" And IsError(Application.Match(Me.ComboBox2, a, 0)) Then
Me.ComboBox2.List = Filter(a, Me.ComboBox2.Text, True, vbTextCompare)
Me.ComboBox2.DropDown
End If
ActiveCell.Value = Me.ComboBox2
End Sub
Private Sub ComboBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.ComboBox2.List = a
Me.ComboBox2.Activate
Me.ComboBox2.DropDown
End Sub
 
Dernière édition:
Solution
VB:
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Me.ComboBox1.List = a
  Me.ComboBox1.Activate
  Me.ComboBox1.DropDown
End Sub

End If

  If Not Intersect([C16:C16], Target) Is Nothing And Target.Count = 1 Then
    Set f = Sheets("BDD")
    a = Application.Transpose(f.Range("B5:B" & f.[A65000].End(xlUp).Row))
    Me.ComboBox2.List = a
    Me.ComboBox2.Height = Target.Height + 3
Vous avez un souci de structure :
Code:
Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Code
End Sub
End If
  If Not Intersect([C16:C16], Target) Is Nothing And Target.Count = 1 Then
    Code
Le End If suit le End Sub et le If Not n'est rattaché à aucune Sub.
Bonjour fredzertya,
( utilisez les balises </> pour le code, c'est plus lisible 😉)
Dans une feuille il ne peut y avoir qu'une macro Worksheet_SelectionChange. Mais on peut faire les traitements à la suite :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect([C14], Target) Is Nothing And Target.Count = 1 Then
        'Code si C14
    Else
        Me.ComboBox1.Visible = False
    End If
    If Not Intersect([C16], Target) Is Nothing And Target.Count = 1 Then
        'Code
    Else
        Me.ComboBox2.Visible = False
    End If
End Sub
 
ou peut être mieux structuré :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect([C14,C16], Target) Is Nothing And Target.Count = 1 Then
        Select Case Target.Address
            Case "$C$14"
                Me.ComboBox2.Visible = False
                MsgBox Target.Address ' à remplacer par code si C14
            Case "$C$16"
                Me.ComboBox1.Visible = False
                MsgBox Target.Address ' à remplacer par code si C16
        End Select
    End If
End Sub
 
Merci pour ta réponse, ça m'aide beaucoup à comprendre.

J'ai tenté de faire le code suivant selon ce que tu m'as préconisé, mais cela ne fonctionne pas pour le combobox 2.

VB:
Dim a()

Private Sub Worksheet_SelectionChange(ByVal Target As Range)


  If Not Intersect([C14:C14], Target) Is Nothing And Target.Count = 1 Then
    Set f = Sheets("BD")
    a = Application.Transpose(f.Range("L1:L" & f.[A65000].End(xlUp).Row))
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = Target.Height + 3
    Me.ComboBox1.Width = Target.Width
    Me.ComboBox1.Top = Target.Top
    Me.ComboBox1.Left = Target.Left
    Me.ComboBox1 = Target
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
  Else
    Me.ComboBox1.Visible = False
  End If
End Sub

Private Sub ComboBox1_Change()
 If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
   Me.ComboBox1.List = Filter(a, Me.ComboBox1.Text, True, vbTextCompare)
   Me.ComboBox1.DropDown
 End If
   ActiveCell.Value = Me.ComboBox1
End Sub

Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Me.ComboBox1.List = a
  Me.ComboBox1.Activate
  Me.ComboBox1.DropDown
End Sub

End If

  If Not Intersect([C16:C16], Target) Is Nothing And Target.Count = 1 Then
    Set f = Sheets("BDD")
    a = Application.Transpose(f.Range("B5:B" & f.[A65000].End(xlUp).Row))
    Me.ComboBox2.List = a
    Me.ComboBox2.Height = Target.Height + 3
    Me.ComboBox2.Width = Target.Width
    Me.ComboBox2.Top = Target.Top
    Me.ComboBox2.Left = Target.Left
    Me.ComboBox2 = Target
    Me.ComboBox2.Visible = True
    Me.ComboBox2.Activate
  Else
    Me.ComboBox2.Visible = False
  End If
End Sub

Private Sub ComboBox2_Change()
 If Me.ComboBox2 <> "" And IsError(Application.Match(Me.ComboBox2, a, 0)) Then
   Me.ComboBox2.List = Filter(a, Me.ComboBox2.Text, True, vbTextCompare)
   Me.ComboBox2.DropDown
 End If
   ActiveCell.Value = Me.ComboBox2
End Sub

Private Sub ComboBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Me.ComboBox2.List = a
  Me.ComboBox2.Activate
  Me.ComboBox2.DropDown
End Sub
 
VB:
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Me.ComboBox1.List = a
  Me.ComboBox1.Activate
  Me.ComboBox1.DropDown
End Sub

End If

  If Not Intersect([C16:C16], Target) Is Nothing And Target.Count = 1 Then
    Set f = Sheets("BDD")
    a = Application.Transpose(f.Range("B5:B" & f.[A65000].End(xlUp).Row))
    Me.ComboBox2.List = a
    Me.ComboBox2.Height = Target.Height + 3
Vous avez un souci de structure :
Code:
Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Code
End Sub
End If
  If Not Intersect([C16:C16], Target) Is Nothing And Target.Count = 1 Then
    Code
Le End If suit le End Sub et le If Not n'est rattaché à aucune Sub.
 
Essayez comme cela :
Code:
Dim a()
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([C14:C14], Target) Is Nothing And Target.Count = 1 Then
    Set f = Sheets("BD")
    a = Application.Transpose(f.Range("L1:L" & f.[A65000].End(xlUp).Row))
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = Target.Height + 3
    Me.ComboBox1.Width = Target.Width
    Me.ComboBox1.Top = Target.Top
    Me.ComboBox1.Left = Target.Left
    Me.ComboBox1 = Target
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
  Else
    Me.ComboBox1.Visible = False
  End If
  If Not Intersect([C16:C16], Target) Is Nothing And Target.Count = 1 Then
    Set f = Sheets("BDD")
    a = Application.Transpose(f.Range("B5:B" & f.[A65000].End(xlUp).Row))
    Me.ComboBox2.List = a
    Me.ComboBox2.Height = Target.Height + 3
    Me.ComboBox2.Width = Target.Width
    Me.ComboBox2.Top = Target.Top
    Me.ComboBox2.Left = Target.Left
    Me.ComboBox2 = Target
    Me.ComboBox2.Visible = True
    Me.ComboBox2.Activate
  Else
    Me.ComboBox2.Visible = False
  End If
End Sub
Private Sub ComboBox1_Change()
 If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
   Me.ComboBox1.List = Filter(a, Me.ComboBox1.Text, True, vbTextCompare)
   Me.ComboBox1.DropDown
 End If
   ActiveCell.Value = Me.ComboBox1
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Me.ComboBox1.List = a
  Me.ComboBox1.Activate
  Me.ComboBox1.DropDown
End Sub
Private Sub ComboBox2_Change()
 If Me.ComboBox2 <> "" And IsError(Application.Match(Me.ComboBox2, a, 0)) Then
   Me.ComboBox2.List = Filter(a, Me.ComboBox2.Text, True, vbTextCompare)
   Me.ComboBox2.DropDown
 End If
   ActiveCell.Value = Me.ComboBox2
End Sub
Private Sub ComboBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Me.ComboBox2.List = a
  Me.ComboBox2.Activate
  Me.ComboBox2.DropDown
End Sub
Non testé évidemment car pas la structure fichier.
 
Il faut vraiment bien indenter votre code. Chaque Sub EndSub, If Endif, For Next doivent être alignés. Cela évite bien des erreurs :
VB:
Dim a()
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect([C14:C14], Target) Is Nothing And Target.Count = 1 Then
    Else
    End If
    If Not Intersect([C16:C16], Target) Is Nothing And Target.Count = 1 Then
    Else
    End If
End Sub
Private Sub ComboBox1_Change()
    If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
    End If
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
End Sub
Private Sub ComboBox2_Change()
   If Me.ComboBox2 <> "" And IsError(Application.Match(Me.ComboBox2, a, 0)) Then
   End If
End Sub
Private Sub ComboBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
3
Affichages
449
Réponses
32
Affichages
1 K
Réponses
0
Affichages
520
Réponses
7
Affichages
704
Retour