XL 2019 ComboBox dans des cellules différenciées avec la même liste

[hemardjean]

Bonjour le forum

Je me tourne à nouveau vers vous, peut-on avec le code suivant utiliser La même ComboBox avec la même liste dans des cellules différenciées ex : en c2 et en e2.

J'ai essayé plusieurs façons mais aucune ne fonctionne.

(Code issu de l'excellent site de M. boisgontierj)


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect([c2:c2], Target) Is Nothing And Target.Count = 1 Then

a = Sheets("BD").Range("listeVilles").Value

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

'Me.ComboBox1.DropDown ' ouverture automatique au clic dans la cellule

Else

Me.ComboBox1.Visible = False

End If

End Sub



Merci d'avance pour votre aide

cordialement

 

[fanch55]

Pensez à supprimer tous les événement de la combobox1,
ils ne servent à rien si vous liez la combobox à la cellule .
Le code ci-dessous ( base @Marcel32 ) lie la cellule et crée la combobox si elle n'existe pas :
Edit: si le classeur ne trouve pas l'objet combobox,
dans le VBE, faites outils/références et cochez la bib Forms 2.0

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim MesCellules As Range
Dim Cbx As msforms.ComboBox

    On Error Resume Next
        Set Cbx = Me.Shapes("Cbx").OLEFormat.Object.Object
        If Err Then
            ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, _
            DisplayAsIcon:=False, Left:=1, Top:=1, Width:=1, Height:=1).Name = "Cbx"
            Set Cbx = Me.Shapes("Cbx1").OLEFormat.Object.Object
        End If
    On Error GoTo 0
   
    Set MesCellules = Range("b34,f34,j34,n34,r34")

    With Cbx
        .Visible = False
        If Not Intersect(Target, MesCellules) Is Nothing And Target.Count = 1 Then
            .LinkedCell = Target.Address
            .List = Sheets("BD").Range("listeVilles").Value
            .Height = Target.Height + 1
            .Width = Target.Width + 2
            .Top = Target.Top
            .Left = Target.Left
            .Value = Target
            .Activate
            .Visible = True
            .DropDown ' ouverture automatique au clic dans la cellule
        End If
    End With

End Sub

 

[hemardjean]

merci à tous les deux pour votre implication , c'est code vont me rendre un grand service.
(Bonne retraite franch55)

bien cordialement touche