Problemes Combobox en cellules avec Dropdown

Résolu/Fermé

Guigui2016 Messages postés 8 Date d'inscription mercredi 26 octobre 2016 Statut Membre Dernière intervention 1 novembre 2016 - 26 oct. 2016 à 15:29
Guigui2016 Messages postés 8 Date d'inscription mercredi 26 octobre 2016 Statut Membre Dernière intervention 1 novembre 2016 - 1 nov. 2016 à 12:36

Bonjour à tous,

Je crée actuellement sur Excel 2007 une base de données de contacts. J'essaye de l'enrichir avec des modules en VBA.

Je rencontre un problème sur une macro que j'ai trouvée sur le web, et que j'ai tenté de modifier pour coller à mes besoins.

Ce à quoi ressemble mon fichier: J'ai designé un formulaire sur l'onglet "New_Contact". Chaque champ (ensemble de cellules fusionnées) est précédé à sa gauche par le nom de sa catégorie. Par exemple , en D13, il y a "Prénom:" et en "H13:O13", une cellule fusionnée vide où il faut inscrire le prénom du contact en cours de création.

Ce que je recherche à faire: En cliquant sur H13, un combobox dropdown s'ouvre et j'ai tous les prénoms de la base de donnée actuelle qui s'affiche. J'ai la possibilité de choisir un prénom déjà présent dans cette liste ou d'en saisir un. Alors, le prénom est validé. Je répète ce processus pour le nom de famille, la ville, la rue...

Mon problème? J'arrive à avoir mes dropdowns, la saisie marche aussi très bien. Mais une fois que j'ai saisi mon prénom pour la cellule H13 et que je clique sur U13 pour le nom de famille, la dropdown ne s'affiche pas en U13 mais reste en H13. J'obtiens quand même la valeur que je veux, mais je trouve que c'est inesthétique. Puis après avoir validé le nom de famille, si je clique sur H16 pour insérer le nom de la ville, alors la dropdown s'affiche sur le champ du nom de famille.

Quelqu'un saurait-il comment éviter ce problème?

Pour Info, toutes mes Combobox s'appellent ComboBox1 et j'ai pris celles de ActiveX.

Je poste ci dessous mon code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveCell = ActiveCell
  If Not Intersect(Range("H13"), ActiveCell) Is Nothing Then
    a1 = "Liste_" & Replace(Replace(ActiveCell.Offset(0, -2).Value, " ", ""), ":", "")
    a = Application.Transpose(Sheets("DB").Range(a1))
    Me.ComboBox1.Clear
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = ActiveCell.Height + 3
    Me.ComboBox1.Width = 151
    Me.ComboBox1.Top = ActiveCell.Top
    Me.ComboBox1.Left = ActiveCell.Left
    Me.ComboBox1 = ActiveCell
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
    Me.ComboBox1.DropDown
  'Else
  '  Me.ComboBox1.Visible = xlVeryHidden
  End If
    
  If Not Intersect(Range("U11, U13, H25, U25, H27, H37"), ActiveCell) Is Nothing Then
    a1 = "Liste_" & Replace(Replace(ActiveCell.Offset(0, -2).Value, " ", ""), ":", "")
    a = Application.Transpose(Sheets("DB").Range(a1))
    Me.ComboBox1.Clear
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = ActiveCell.Height + 3
    Me.ComboBox1.Width = 151
    Me.ComboBox1.Top = ActiveCell.Top
    Me.ComboBox1.Left = ActiveCell.Left
    Me.ComboBox1 = ActiveCell
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
    Me.ComboBox1.DropDown
  Else
    Me.ComboBox1.Visible = xlVeryHidden
  End If
  
  If Not Intersect(Range("H16, H23, H34"), ActiveCell) Is Nothing Then
    a1 = "Liste_" & Replace(Replace(ActiveCell.Offset(0, -2).Value, " ", ""), ":", "")
    a = Application.Transpose(Sheets("DB").Range(a1))
    Me.ComboBox1.Clear
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = ActiveCell.Height + 3
    Me.ComboBox1.Width = 395
    Me.ComboBox1.Top = ActiveCell.Top
    Me.ComboBox1.Left = ActiveCell.Left
    Me.ComboBox1 = ActiveCell
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
    Me.ComboBox1.DropDown
  Else
    Me.ComboBox1.Visible = xlVeryHidden
  End If
  
  If Not Intersect(Target, Range("H27")) Is Nothing Then
    Formule = "=IFERROR(""+""&VLOOKUP($H$27,Liste_IndicatifTel,2,0),"""")"
    Range("H30, U30, U32").Formula = Formule
  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

En espérant avoir été clair, merci d'avoir lu mon message.

Guillaume

A voir également:

Problemes Combobox en cellules avec Dropdown
Excel additionner des cellules - Guide
Verrouiller cellules excel - Guide
Excel fusionner deux cellules - Guide
Figer des cellules excel - Guide
Excel ne peut pas insérer de nouvelles cellules car cela déplacerait des cellules non vides ✓ - Forum Excel

2 réponses

Réponse 1 / 2

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
26 oct. 2016 à 16:55

Bonjour,

Commencez par enlever les ActiveCell des Not Intersect

Guigui2016 Messages postés 8 Date d'inscription mercredi 26 octobre 2016 Statut Membre Dernière intervention 1 novembre 2016
26 oct. 2016 à 17:40

Merci, pour la réponse.

En effet, le code initial contenait Target. Vu que j avais le même problème, je les ai remplacés par Activecell. Donc ca marche ni avec l'un ni avec l'autre.

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701 > Guigui2016 Messages postés 8 Date d'inscription mercredi 26 octobre 2016 Statut Membre Dernière intervention 1 novembre 2016
26 oct. 2016 à 18:48

Re,

plus complet: faut target

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("H13")) Is Nothing Then
    a1 = "Liste_" & Replace(Replace(ActiveCell.Offset(0, -2).Value, " ", ""), ":", "")
    a = Application.Transpose(Sheets("DB").Range(a1))
    Me.ComboBox1.Clear
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = ActiveCell.Height + 3
    Me.ComboBox1.Width = 151
    Me.ComboBox1.Top = ActiveCell.Top
    Me.ComboBox1.Left = ActiveCell.Left
    Me.ComboBox1 = ActiveCell
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
    Me.ComboBox1.DropDown
  ElseIf Not Intersect(Target, Range("U11, U13, H25, U25, H27, H37")) Is Nothing Then
    a1 = "Liste_" & Replace(Replace(ActiveCell.Offset(0, -2).Value, " ", ""), ":", "")
    a = Application.Transpose(Sheets("DB").Range(a1))
    Me.ComboBox1.Clear
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = ActiveCell.Height + 3
    Me.ComboBox1.Width = 151
    Me.ComboBox1.Top = ActiveCell.Top
    Me.ComboBox1.Left = ActiveCell.Left
    Me.ComboBox1 = ActiveCell
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
    Me.ComboBox1.DropDown
  ElseIf Not Intersect(Target, Range("H16, H23, H34")) Is Nothing Then
    a1 = "Liste_" & Replace(Replace(ActiveCell.Offset(0, -2).Value, " ", ""), ":", "")
    a = Application.Transpose(Sheets("DB").Range(a1))
    Me.ComboBox1.Clear
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = ActiveCell.Height + 3
    Me.ComboBox1.Width = 395
    Me.ComboBox1.Top = ActiveCell.Top
    Me.ComboBox1.Left = ActiveCell.Left
    Me.ComboBox1 = ActiveCell
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
    Me.ComboBox1.DropDown
  Else
    Me.ComboBox1.Visible = xlVeryHidden
  End If
  
  If Not Intersect(Target, Range("H27")) Is Nothing Then
    Formule = "=IFERROR(""+""&VLOOKUP($H$27,Liste_IndicatifTel,2,0),"""")"
    Range("H30, U30, U32").Formula = Formule
  End If
    
End Sub

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701 > f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024
27 oct. 2016 à 08:28

Bonjour,

Avec combobox cachee sur cellule precedente:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("H13")) Is Nothing Then
    a1 = "Liste_" & Replace(Replace(ActiveCell.Offset(0, -2).Value, " ", ""), ":", "")
    a = Application.Transpose(Sheets("DB").Range(a1))
    Me.ComboBox1.Visible = False
    Me.ComboBox1.Clear
    Me.ComboBox1.List() = a
    Me.ComboBox1.Height = ActiveCell.Height + 3
    Me.ComboBox1.Width = 151
    Me.ComboBox1.Top = ActiveCell.Top
    Me.ComboBox1.Left = ActiveCell.Left
    Me.ComboBox1 = ActiveCell
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
    Me.ComboBox1.DropDown
  ElseIf Not Intersect(Target, Range("U11, U13, H25, U25, H27, H37")) Is Nothing Then
    a1 = "Liste_" & Replace(Replace(ActiveCell.Offset(0, -2).Value, " ", ""), ":", "")
    a = Application.Transpose(Sheets("DB").Range(a1))
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Clear
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = ActiveCell.Height + 3
    Me.ComboBox1.Width = 151
    Me.ComboBox1.Top = ActiveCell.Top
    Me.ComboBox1.Left = ActiveCell.Left
    Me.ComboBox1 = ActiveCell
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
    Me.ComboBox1.DropDown
  ElseIf Not Intersect(Target, Range("H16, H23, H34")) Is Nothing Then
    a1 = "Liste_" & Replace(Replace(ActiveCell.Offset(0, -2).Value, " ", ""), ":", "")
    a = Application.Transpose(Sheets("DB").Range(a1))
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Clear
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = ActiveCell.Height + 3
    Me.ComboBox1.Width = 395
    Me.ComboBox1.Top = ActiveCell.Top
    Me.ComboBox1.Left = ActiveCell.Left
    Me.ComboBox1 = ActiveCell
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
    Me.ComboBox1.DropDown
  Else
    Me.ComboBox1.Visible = xlVeryHidden
  End If
  
  If Not Intersect(Target, Range("H27")) Is Nothing Then
    Formule = "=IFERROR(""+""&VLOOKUP($H$27,Liste_IndicatifTel,2,0),"""")"
    Range("H30, U30, U32").Formula = Formule
  End If
    
End Sub

Guigui2016 Messages postés 8 Date d'inscription mercredi 26 octobre 2016 Statut Membre Dernière intervention 1 novembre 2016
27 oct. 2016 à 10:34

Merci de prendre du temps, mais ca n'a pas fonctionné.

Réponse 2 / 2

Guigui2016 Messages postés 8 Date d'inscription mercredi 26 octobre 2016 Statut Membre Dernière intervention 1 novembre 2016
27 oct. 2016 à 10:33

Bonjour,

Merci pour vos propositions. Mais mon problème reste le même.

J'ai épuré mon fichier, et vous le mets ici en copie. Peut être qu'en ayant le fichier directement, ca pourra plus vous aider.

Merci,
G.

http://www.cjoint.com/c/FJBiGIPidBk

Guigui2016 Messages postés 8 Date d'inscription mercredi 26 octobre 2016 Statut Membre Dernière intervention 1 novembre 2016
27 oct. 2016 à 10:43

Je tiens à préciser que le problème arrive lorsque je veux passer d'une combobox à une autre. Si je clique sur une cellule entre deux combobox, ca marche parfaitement.

Re,

Ok, je recupere le fichier

fichier modifie, c'est moi qui ait fait des copier/coller maltpropos
Me.ComboBox1.Visible = True
ald
Me.ComboBox1.Visible = False
pour les series cellules 2 et 3

https://www.cjoint.com/c/FJBi4GuCwAf

A+

Guigui2016 Messages postés 8 Date d'inscription mercredi 26 octobre 2016 Statut Membre Dernière intervention 1 novembre 2016 > f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024
30 oct. 2016 à 11:26

Merci bien!

Je viens de voir ton message à peine. Je regarde ca sous les prochains jours et je te tiens au courant.

Bon dimanche!

Guigui2016 Messages postés 8 Date d'inscription mercredi 26 octobre 2016 Statut Membre Dernière intervention 1 novembre 2016 > Guigui2016 Messages postés 8 Date d'inscription mercredi 26 octobre 2016 Statut Membre Dernière intervention 1 novembre 2016
1 nov. 2016 à 12:01

Ca y est je viens de comparer le code que j avais soumis et le tien.

J'ai compris d'où venait l'erreur, merci encore!

Je reviens au cas où ca puisse aider qq'un...

Je viens de remplacer

Me.ComboBox1.Visible = xlVeryHidden

par

Me.ComboBox1.Visible = False

Je pensais que c était la même chose, mais non. Dans le premier cas, si je passe d'une combobox à une cellule qui n'en a pas, la combobox reste active dans la cellule précédente. Avec False, elle disparaît - ca règle juste un problème d'esthétique...

Discussions similaires

Cellules en surbrillance selon une TextBox

=Si la cellule A1 a du texte = B1 devient couleur

Mise en forme conditionnelle "compris entre"

Impossible fusionner cellules

Quel fonction faire en b1 par rapport à a1

Discussions similaires

Newsletters