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

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.

sylvanu

XLDnaute Barbatruc
Supporter XLD
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
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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
 

fredzertya

XLDnaute Nouveau
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
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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
 

Discussions similaires

Réponses
4
Affichages
467