XL 2016 Activer Combobox seulement quand je click sur la cellule liée

[Philonce]

Bonjour,

j'ai créer un système de recherche pour des tables d'opérations qui sont dans un feuille BD_Tables.
J'ai créé des Combobox pour chacunes des disciplines pour choisir le type de l'intervention et ensuite dans une autre cellule , il y a une formule index et equiv pour retrouver la table à utiliser.

Tout se passe bien jusque là sauf que lorsque je tape mon texte dans la première combobox. Nickel. Par contre, je tape dans la deuxième combobox mon texte, et là, la première s'ouvre....Je voudrais que seul la combobox concernée soient active lorsque je click dans la cellule liée. J'ai cherché beaucoup, mais tout ce que j'ai testé ne fonctionne pas. C'est le dernier truc qui me bloque pour finaliser, et je ne sais plus ou trouver ma solution.

J'espère que ce forum est toujours actif.

Merci d'avance,

 

[job75]

Bonsoir patricktoulon,

C'est surtout que le fichier original utilise une très mauvaise méthode.

A+

 

[patricktoulon]

ben oui il faudrait tout revoir ses name
1 perso je l'es éliminerais tous je ne garderais que le ts
2 listfillrange on oublie .list de toutes les combo a l'open

le probleme qui se passe
quand on sélectionne dans la combo1 ok
quand on va dans la 2la liste se remplie avec un names qui a pour source index((blablabla)
sauf que cette plage fait parti du TS donc si tu change la 2 ben tu change le listfillrange de la 1 forcement même si la liste est la même

vire moi tout ça

 

[job75]

@patricktoulon J'ai l'impression que tu n'as pas regardé ce que j'ai fait, il vaut mieux aller dormir

Bonne nuit.

 

[patricktoulon]

oui j'ai vu ce que tu a fait
je suis sur son fichier d'origine pour l'instant avec juste les code change des combo tu a gardé tout les names?

 

[job75]

tu a gardé tout les names?

Regarde ce que j'ai fait nom d'une pipe.

J'ai revu les noms des listes comme ListeCardio et supprimé ceux qui ne servaient à rien.

Les listes sont chargées avec .List.

 

[patricktoulon]

re
oui voilà c'est plus simple
le gotfocus apel le change
si elle est vide c'est les "*" dans ta sub qui donneront la liste complète sinon la liste triées par le like encadré des "*"
simple
tu veux une classe pour ça ?

 

[job75]

Un Module de classe ne va pas car GotFocus n'existe alors pas.

Et le MouseDown que tu as proposé sur le fil de Magic_Doctor ne va pas du tout.

 

[patricktoulon]

ho!! relax bonhomme
chez moi le mouse down fonctionne

 

[patricktoulon]

tiens j'ai remplacé les gotfocus par les mousedown+ condition button 1
j'ai exactement le même effet

Option Explicit



Private Sub ComboBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then ComboBox1_Change
End Sub

Private Sub ComboBox2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then ComboBox2_Change
End Sub

Private Sub ComboBox3_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then ComboBox3_Change
End Sub

Private Sub ComboBox4_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then ComboBox4_Change
End Sub

Private Sub ComboBox5_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then ComboBox5_Change
End Sub
Private Sub ComboBox6_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then ComboBox6_Change
End Sub
Private Sub ComboBox7_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then ComboBox7_Change
End Sub
Private Sub ComboBox8_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then ComboBox8_Change
End Sub
Private Sub ComboBox9_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then ComboBox9_Change
End Sub



Private Sub ComboBox1_Change()
    Liste ComboBox1, [ListeCardio]
End Sub

Private Sub ComboBox2_Change()
    Liste ComboBox2, [ListeUro]
End Sub

Private Sub ComboBox3_Change()
    Liste ComboBox3, [ListeAbdo]
End Sub

Private Sub ComboBox4_Change()
    Liste ComboBox4, [ListeMaxillo]
End Sub

Private Sub ComboBox5_Change()
    Liste ComboBox5, [ListeOphtalmo]
End Sub

Private Sub ComboBox6_Change()
    Liste ComboBox6, [ListeOrtho]
End Sub

Private Sub ComboBox7_Change()
    Liste ComboBox7, [ListeORL]
End Sub

Private Sub ComboBox8_Change()
    Liste ComboBox8, [ListeNeuro]
End Sub

Private Sub ComboBox9_Change()
    Liste ComboBox9, [ListeSeno]
End Sub

Sub Liste(cb As ComboBox, R As Range)
    Dim X$, tablo, i&, Y$, a$(), n&
    X = "*" & LCase(cb) & "*"    'critère en minuscules avec caractère générique
    tablo = R    'matrice, plus rapide
    For i = 1 To UBound(tablo)
        Y = tablo(i, 1)
        If LCase(Y) Like X Then
            ReDim Preserve a(n)
            a(n) = Y
            n = n + 1
        End If
    Next
    If n = 0 Then ReDim a(0)
    cb.List = a
    cb.DropDown    'déroule la liste
End Sub

 

[job75]

Dans la ComboBox1_GotFocus il y a ComboBox1 = ""

Si on met cette instruction dans ComboBox1_MouseDown ça ne va pas.

On ne peut pas récupérer certains items comme Maze.

 

[patricktoulon]

re
tiens tu voulais une classe
vide le code de la feuille
et
dans le open du worlbook

Dim cls As New CbClasse
Private Sub Workbook_Open()
cls.init
End Sub

dans un module classe nommé"cbclasse"

Option Explicit
Public WithEvents cb As MSForms.ComboBox
Dim cls() As New CbClasse
Public RG As Range
Public Function init()
    Dim a&, c, Co As MSForms.ComboBox
    For Each c In Feuil1.OLEObjects
         If InStr(1, c.Name, "ComboBox") > 0 Then
            a = a + 1: Set Co = c.Object: ReDim Preserve cls(1 To a): Set cls(a).cb = Co
        End If
    Next
End Function

Private Sub cb_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    cb_Change
End Sub

Private Sub cb_Change()
    Select Case cb.Name
    Case "ComboBox1": Liste cb, [ListeCardio]
    Case "ComboBox2": Liste cb, [ListeUro]
    Case "ComboBox3": Liste cb, [ListeAbdo]
    Case "ComboBox4": Liste cb, [ListeMaxillo]
    Case "ComboBox5": Liste cb, [ListeOphtalmo]
    Case "ComboBox6": Liste cb, [ListeOrtho]
    Case "ComboBox7": Liste cb, [ListeORL]
    Case "ComboBox8": Liste cb, [ListeNeuro]
    Case "ComboBox9": Liste cb, [ListeSeno]
    End Select
End Sub
Public Sub Liste(cb As ComboBox, R As Range)
    Dim X$, tablo, i&, Y$, a$(), n&
    X = "*" & LCase(cb) & "*"    'critère en minuscules avec caractère générique
    tablo = R    'matrice, plus rapide
    For i = 1 To UBound(tablo)
        Y = tablo(i, 1)
        If LCase(Y) Like X Then
            ReDim Preserve a(n)
            a(n) = Y
            n = n + 1
        End If
    Next
    If n = 0 Then ReDim a(0)
    cb.List = a
    cb.DropDown    'déroule la liste
End Sub

 

[patricktoulon]

Dans la ComboBox1_GotFocus il y a ComboBox1 = ""

Si on met cette instruction dans ComboBox1_MouseDown ça ne va pas.

On ne peut pas récupérer certains items comme Maze.

attend il faut que je reprenne ton fichier pour voir l'effet

 

[patricktoulon]

ok
j'ajoute même le bouton droite de la souris qui dropdown la combo (else)

Private Sub cb_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then
        If Y > cb.Height - 6 Then Exit Sub
        cb = ""
        cb_Change
    Else
        If Y < cb.Height Then cb.DropDown
    End If
End Sub

 

[Philonce]

Re bonjour et merci pour cette belle battle. Mais du coup je suis perdu. Qui est le meilleur

Je ne sais plus quels fichiers est le plus efficace et surtout je ne comprend pas toutes les différences que vous avez débatues.....

Mais merci pour tout le travail en tout cas Je vais analyser le tout comme je peux. Et surtout pouvoir en faire profiter mon équipe.

Bien à vous,

 

[Philonce]

Ah si j'ai encore une petite requête. Dans mon fichier initial, j'avais un code qui permettait à la combobox de prendre exactement la même dimension que la cellule même si je modifie la cellule.

Me.combobox1.top = Target.top
Me.combobox1.left = Target.left
Me.combobox1.width = Target.width
Me.combobox1.height = Target.height

Est-ce qu'il existe une autre façon pour avoir le même effet que ce code ou sinon, puis-je placer ce code dans le vôtre pour avoir cet effet, et si oui, où ?

Merci d'avance,