ListBox

[manu900]

Bonjour à tous, nouveau sur ce forum j'ai terriblement besoin de votre aide pour l'utilisation de la fonction listbox.
Bien évidemment j'ai déja chercher un peu partout su le forum et je n'ai pas trouvé de réponse.

Je cherche un moyen de créer une listbox qui recueille les imformations à partir d'un critère d'une cellule.

Exemple par rapport au fichier ci-joint :Regarde la pièce jointe test.xlsm

. Si cellule A19 = poire, alors liste déroulante cellule C19 = mure,sucre,bon
autre exemple
.Si cellule A20 = peche, alors liste déroulante cellule C20 = bonne, très bonne.

Sub Bouton1_Clic()
 
    Sheets("feuil1").Select
   Sheets("feuil1").Copy after:=Sheets("feuil1")
    Sheets("feuil1 (2)").Select
    Sheets("feuil1 (2)").Name = "copie"
 
   Application.EnableEvents = False ' => désactive les événements
 
    With Sheets("copie")

  m = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
  p = .Cells(.Rows.Count, "B").End(xlUp).Row + 6
 
  With .Range(.Cells(m, 2), .Cells(p, 2)).Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
      xlBetween, Formula1:="CONTROLER,ANALYSER,AJOUTER,VERIFIER"
  End With
End With
End Sub

J'ai réussi à créer pour la cellule B19 une liste déroulante à partir de donner que j'ai moi même définie, mais je n'arrive pas à créer la liste par rapport aux données de la feuille.

Merci pour vos réponses.

Cordialement.

 

[jp14]

Re : ListBox

Bonjour et bienvenue sur le forum

Ci joint un fichier avec un userform qui affiche les valeurs demandées en fonction du choix du fruit.

A tester

JP

 

[manu900]

Re : ListBox

Merci jp14 pour ta réactivité, comment faire pour ne pas mettre en user forme mais que la liste aparraisse dans la cellule C19?

Merci encore.

 

[jp14]

Re : ListBox

Bonjour
Ci dessous le code qui réalise cette opération

Lig1 = CLng(ComboBox1.List(ComboBox1.ListIndex, 1))
Lig2 = CLng(ComboBox1.List(ComboBox1.ListIndex, 2))

For I = Lig1 To Lig2
     Sheets(nomfeuille1).Range("c" & 19) = Sheets(nomfeuille1).Range("c" & 19) & " " & Sheets(nomfeuille1).Range("e" & I)
Next I

A tester

JP

 

[manu900]

Re : ListBox

Désolé je suis novice JP, il m'indique une erreur "objet d'execution 424" Objet requis, comment faire pour résoudre?
Merci encore

Sub Bouton1_Clic()
 Dim Lig1 As Long
Dim Lig2 As Long
    Sheets("feuil1").Select
   Sheets("feuil1").Copy after:=Sheets("feuil1")
    Sheets("feuil1 (2)").Select
    Sheets("feuil1 (2)").Name = "copie"
 
   Application.EnableEvents = False ' => désactive les événements
 
    With Sheets("copie")

  m = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
  p = .Cells(.Rows.Count, "B").End(xlUp).Row + 6
 
  With .Range(.Cells(m, 2), .Cells(p, 2)).Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="CONTROLER,ANALYSER,AJOUTER,VERIFIER"
      
    Lig1 = CLng(ComboBox1.List(ComboBox1.ListIndex, 1)) 'erreur sur cette ligne
    Lig2 = CLng(ComboBox1.List(ComboBox1.ListIndex, 2))

    For I = Lig1 To Lig2
     Sheets(nomfeuille1).Range("c" & 19) = Sheets(nomfeuille1).Range("c" & 19) & " " & Sheets(nomfeuille1).Range("e" & I)
    Next I
    End With

  End With

End Sub

 

[jp14]

Re : ListBox

Bonjour

Ci dessous une macro qui génère des liste de validations de données dans la colonne C en fonction de nom du fruit qui se trouve dans la colonne A.
Code qui devrait correspondre plus à la demande.
Il est possible de travailler sur deux feuilles en modifiant le nom de la feuille au niveau du passage des paramètres

essai1 Sheets(nomfeuille1).Range(col & I), nomfeuille1
listederoulante "c" & I, "E" & Ligne1 & ":" & "e" & Ligne2, nomfeuille1

Option Explicit
Dim Ligne1 As Long
Dim Ligne2 As Long
Dim nomfeuille1 As String

Sub essai()
'listederoulante "c22", "E1" & ":" & "e3"
Dim col As String
Dim Ligdep As Integer
Dim I As Long, J As Long
'paramètre
col = "a"
nomfeuille1 = "Feuil1"
Ligdep = 2


    For I = 20 To Sheets(nomfeuille1).Range(col & Columns(1).Cells.Count).End(xlUp).Row
            If Sheets(nomfeuille1).Range(col & I) <> "" Then
            Ligne1 = 0: Ligne2 = 0
            essai1 Sheets(nomfeuille1).Range(col & I), nomfeuille1
            listederoulante "c" & I, "E" & Ligne1 & ":" & "e" & Ligne2, nomfeuille1
            End If
    Next I



End Sub
Private Sub essai1(Valeur1 As String, nomfeuille2 As String)
Dim col As String
Dim Ligdep As Integer
Dim I As Long, J As Long
'paramètre
col = "a"
Ligdep = 2


    For I = Ligdep To 18
            If Sheets(nomfeuille2).Range(col & I) = Valeur1 Then
            Ligne1 = I
            For J = I + 1 To 18
                If Sheets(nomfeuille2).Range(col & J) <> Sheets(nomfeuille2).Range(col & I) Then Exit For
            Next J
            Ligne2 = J - 1
            Exit For
        End If
    Next I



End Sub


Private Sub listederoulante(cellule As String, adresse As String, nomfeuille2 As String)

 
    With Sheets(nomfeuille2).Range(cellule).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=" & adresse
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

End Sub

A tester

JP

 

[jp14]

Re : ListBox

Désolé je suis novice JP, il m'indique une erreur "objet d'execution 424" Objet requis, comment faire pour résoudre?
Merci encore

[/CODE]

Le code correspond à l'userform : ComboBox1.List(ComboBox1.ListIndex, 1 qui je pense n'existe pas, d’où l'erreur.

JP

 

[manu900]

Re : ListBox

Escuse moi JP, mais cela ne fonctionne pas, ci joint le fichier mis à jour avec ton code.
Regarde la pièce jointe test.xlsm
Merci.

 

[jp14]

Re : ListBox

Bonjour (re)

Ci joint le fichier

JP

 

[manu900]

Re : ListBox

Merci JP, c'est presque cela. Toutefois la cellule A20 peut être égale différent fruit. il faudrait actualiser la liste déroulante par rapport au fruit que l'on met dans les cellules.

Merci encore

 

[jp14]

Re : ListBox

Bonsoir

Il suffit de relancer la procédure avec le bouton, ou créer une macro évènementielle.

JP