XL 2013 Affiche automatique liste validation au clic dans la cellule

[Usine à gaz]

Bonjour à toutes et à tous,

Voilà longtemps que je ne vous ai pas sollicité.

Après avoir été souffrant, je reprends peu à peu la "forme"

Petit souci pour lequel, malgré mes recherches, je n'ai pas trouvé la solution :

Dans le fichier test joint, et dans la cellule G7, j'ai une petite liste de validation
J'aurais besoin qu'au clic dans cette cellule, la liste de sélection s'affiche automatiquement.
Sans avoir à cliquer sur le bouton pour dérouler le menu
Est-ce possible ?
Auriez-vous la solution ?

Avec mes remerciements,
Je vous souhaite à toutes et à tous une très belle journée
Amicalement,
arthour973,

 

[job75]

Re,

Fichier (3) avec ce code :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ComboBox1
    .Visible = False
    If Not Intersect(ActiveCell, [G7:G500]) Is Nothing Then _
        .Top = ActiveCell.Top: .Visible = True: .Activate
End With
End Sub

Private Sub ComboBox1_GotFocus()
Dim i As Variant
With ComboBox1
    .List = Array("ALLO", "HELLO", "CHALUT")
    i = Application.Match(ActiveCell, .List, 0)
    If IsError(i) Then i = 0
    .ListIndex = i - 1
    .DropDown 'déroule la liste
End With
End Sub

Private Sub ComboBox1_Change()
If ComboBox1.ListIndex = -1 Then ComboBox1 = ""
ActiveCell = ComboBox1
ActiveCell.Activate 'ôte le focus
End Sub

La macro ComboBox1_GotFocus a été revue pour que le contenu de la cellule active soit affiché.

A+

 

[Si...]

re

transformation relativement simple

Private Sub Worksheet_SelectionChange(ByVal R As Range)
  If Intersect(R, [G7:G500]) Is Nothing  Then Lst.Visible = 0: Exit Sub
  Lst.List = Array("ALLO", "HELLO", "CHALUT", " ") :  Lst.Visible = 1: Lst.Top = R.Top
End Sub
Private Sub Lst_Change()
  ActiveCell = Lst: ActiveCell(1, 2).Select: Lst.Clear
End Sub

 

[Usine à gaz]

Merci JOB

En plus parfaitement pratique car quelle que soit la longueur de la liste, elle s'affiche toute au clic sur la cellule sans avoir à se "promener" sur des curseurs (enfin, jusqu'à liste de 8 mais c'est déjà très bien)

 

[Usine à gaz]

Un grand Merci à toi aussi Si
Amicalement,
Arthour973

 

[BOISGONTIER]

Bonjour,



>En plus parfaitement pratique car quelle que soit la longueur de la liste, elle s'affiche toute au clic sur la cellule sans avoir à se "promener" sur des curseurs (enfin, jusqu'à liste de 8 mais c'est déjà très bien)

La saisie intuitive raccourcit la liste au fur et à mesure de la frappe des caractères.

Dim a(), mémo, f
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set f = Sheets("bd")
  Set zSaisie = Range("A2:A16")
  If Not Intersect(zSaisie, Target) Is Nothing And Target.Count = 1 Then
    If mémo <> "" Then If IsError(Application.Match(Range(mémo), a, 0)) Then Range(mémo) = ""
    a = Application.Transpose(f.Range("a2:a" & 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
    mémo = Target.Address
    Me.ComboBox1.DropDown
  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
    Set d1 = CreateObject("Scripting.Dictionary")
    tmp = UCase(Me.ComboBox1) & "*"
    For Each c In a
      If UCase(c) Like tmp Then d1(c) = ""
    Next c
    Me.ComboBox1.List = d1.keys
    Me.ComboBox1.DropDown
  End If
  ActiveCell.Value = Me.ComboBox1
End Sub

http://boisgontierjacques.free.fr/pages_site/listes_cascade.htm#Simul_DV


ps: GotFocus ne sert à rien
http://boisgontierjacques.free.fr/fichiers/DonneesValidation/DVComboBox.xls


jb

 

[Usine à gaz]

Bonjour JB,

Merci pour ce nouveau fichier effectivement la saisie intuitive c'est bien aussi
Amicalement,
Arthour973,