XL 2010 Problème code liste déroulante semi automatique

pezz44

XLDnaute Nouveau
Bonjour à tous,

j'ai besoin de votre aide, je souhaite réaliser une liste semi automatique mais j'ai plusieurs erreurs que je n'arrive pas à modifier , j'ai trouvé le code ci dessous sur internet.
La base de donnée de ma liste déroulante se trouve dans un onglet appelé : Données TDB
La colonne ou je souhaite mettre en place la liste déroulante est : D4 à D …...

j'ai commencé à modifier dans le code ( je vous met à cote du texte avec une flèche ce que j'avais mis )

Mais mon soucis c'est que cela ne fonctionne pas j'ai 2 erreurs les ligne de code ci dessous :
- If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
- For Each c In a

Je vous remercie par avance pour votre aide :)

Dim a(), mémo, f
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set f = Sheets("bd") ---> Données TDB
Set zSaisie = Range("A2:A16") ---> ( D4:D1000)
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
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
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ComboBox1.List = Application.Transpose(f.Range("a2:a" & f.[A65000].End(xlUp).Row))
Me.ComboBox1.DropDown
End Sub
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
If IsError(Application.Match(ActiveCell, a, 0)) Then ActiveCell = ""
ActiveCell.Offset(1).Select
End If
End Sub
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas