Problemes Combobox en cellules avec Dropdown

Résolu

Guigui2016 Messages postés 8 Date d'inscription Statut Membre Dernière intervention -
Guigui2016 Messages postés 8 Date d'inscription Statut Membre Dernière intervention - 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

Afficher la suite

A voir également:

Problemes Combobox en cellules avec Dropdown
Formule excel pour additionner plusieurs cellules - Guide
Verrouiller cellules excel - Guide
Fusionner deux cellules excel en gardant le contenu - Guide
Afficher cellules masquées excel ✓ - Forum Excel
Diviser une cellule excel en deux horizontalement ✓ - Forum Excel

2 réponses

Réponse 1 / 2

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,

Commencez par enlever les ActiveCell des Not Intersect

Guigui2016 Messages postés 8 Date d'inscription Statut Membre Dernière intervention

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 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > Guigui2016 Messages postés 8 Date d'inscription Statut Membre Dernière intervention

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 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention

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 Statut Membre Dernière intervention

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

Réponse 2 / 2

Guigui2016 Messages postés 8 Date d'inscription Statut Membre Dernière intervention

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 Statut Membre Dernière intervention

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.

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > Guigui2016 Messages postés 8 Date d'inscription Statut Membre Dernière intervention

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 Statut Membre Dernière intervention > f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention

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 Statut Membre Dernière intervention > Guigui2016 Messages postés 8 Date d'inscription Statut Membre Dernière intervention

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!

Guigui2016 Messages postés 8 Date d'inscription Statut Membre Dernière intervention > f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention

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

additionner nombres dans cellules avec texte

afficher des colonnes masquées sur EXCEL

Cellules en surbrillance selon une TextBox

Mise en forme conditionnelle "compris entre"

Reactiver la fusion des cellules, tableau exc

Votre réponse

Discussions similaires