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

F

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
sylvanu
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.
Trier par date Trier par votes
sylvanu

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
 
Vote positif 0 Vote négatif
sylvanu

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
 
Vote positif 0 Vote négatif
F

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
 
Vote positif 0 Vote négatif
sylvanu

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.
 
Vote positif 0 Vote négatif
Solution
sylvanu

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.
 
Vote positif 0 Vote négatif
sylvanu

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
 
Vote positif 0 Vote négatif

Discussions similaires

Regueiro
  • Question
Microsoft 365 Format Nombre Combobox dans Feuille
Réponses
3
Affichages
381
fanch55
fanch55
lynyrd
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
528
AtTheOne
AtTheOne
Dadi147
  • Résolu(e)
XL 2019 Importer des données de colonne spécifiques dans combobox
Réponses
4
Affichages
945
fanfan38
fanfan38
E
  • Résolu(e)
XL 2019 effacer combobox
Réponses
4
Affichages
703
ChTi160
ChTi160
N
  • Résolu(e)
Microsoft 365 Aide pour un code Vba
2 3
Réponses
32
Affichages
961
Nicolas JACQUIN
Nicolas JACQUIN
hemardjean
  • Question
XL 2019 ComboBox dans des cellules différenciées avec la même liste
2
Réponses
16
Affichages
2 K
hemardjean
hemardjean
E
  • Résolu(e)
XL 2019 ComboBox afficher 2 colonnes
Réponses
6
Affichages
1 K
exe76
E
U
  • Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
328
Phil69970
Phil69970
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
502
un internaute
U
R
  • Résolu(e)
XL 2019 Plusieurs Worksheet_Change sur la même feuille
Réponses
9
Affichages
549
Rabeto
R

Membres actuellement en ligne

15 membres et 106 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 093
Messages
2 116 138
Membres
112 669
dernier inscrit
Guigui2502