Problemes Combobox en cellules avec Dropdown

Résolu
Guigui2016 Messages postés 8 Statut Membre -  
Guigui2016 Messages postés 8 Statut Membre -
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

2 réponses

  1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    Commencez par enlever les ActiveCell des Not Intersect
    0
    1. Guigui2016 Messages postés 8 Statut Membre
       
      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.
      0
      1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > Guigui2016 Messages postés 8 Statut Membre
         
        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
        
        0
      2. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > f894009 Messages postés 17417 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
        0
    2. Guigui2016 Messages postés 8 Statut Membre
       
      Merci de prendre du temps, mais ca n'a pas fonctionné.
      0
  2. Guigui2016 Messages postés 8 Statut Membre
     
    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
    0
    1. Guigui2016 Messages postés 8 Statut Membre
       
      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.
      0
      1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > Guigui2016 Messages postés 8 Statut Membre
         
        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+
        0
      2. Guigui2016 Messages postés 8 Statut Membre > f894009 Messages postés 17417 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!
        0
      3. Guigui2016 Messages postés 8 Statut Membre > Guigui2016 Messages postés 8 Statut Membre
         
        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!
        0
      4. Guigui2016 Messages postés 8 Statut Membre > f894009 Messages postés 17417 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...
        0