Listbox à deux colonnes

Bonjour,

Voilà j'ai un petit souci, je n'ai jamais alimenté une listbox à 2 colonnes et je n'arrive pas à l'intégrer dans mon code.

L'appli est la suivante: je tape une ref dans une textbox, la recherche se fait dans la colonne "I" et rempli la listbox1 avec le contenu de la colonne "A" de la même ligne. Tout fonctionne correctement mais je souhaiterai à la place avoir 2 colonnes dans ma listbox1. La première colonne pour le contenu de la colonne "A" et la seconde le contenu de la colonne "B".

Merci d'avance.

Private Sub CommandButtonRechercheVin_Click()

Dim Cel As Range, Depart As String, ref As String, F As Worksheet

ref = Me.ComboRechercheVin.Text

With Me.ListBox1

.Clear: If ref = "" Then Exit Sub

.Visible = False

End With

For Each F In Worksheets

If F.Name <> "Menu" And F.Name <> "Ma Cave" Then

With F

Set Cel = .Columns("I").Cells.Find(What:=ref, LookIn:=xlValues, lookat:=xlPart)

If Not Cel Is Nothing Then

ajout_liste ListBox1, .Range("A" & Cel.Row).Value

Depart = Cel.Address

Do

Set Cel = .Columns("I").Cells.FindNext(Cel)

If Not Cel Is Nothing Then ajout_liste ListBox1, .Range("A" & Cel.Row).Value Else Exit Do

Loop While Depart <> Cel.Address Or Cel Is Nothing

End If

End With

End If

Next

ListBox1.Visible = True

If ListBox1.ListCount = 0 Then

MsgBox "Pas trouvé de vin en accord avec " & ref & "", vbCritical

End If

End Sub

Private Sub ajout_liste(LB As Object, c As String)

LB.ListIndex = -1

On Error Resume Next

LB.Text = c

On Error GoTo 0

If LB.ListIndex = -1 Then LB.AddItem c

End Sub

Bonjour

Sans support (fichier) pour tester peut être des erreurs

Private Sub CommandButtonRechercheVin_Click()
Dim Cel As Range, Depart As String, ref As String, F As Worksheet
  ref = Me.ComboRechercheVin.Text
  With Me.ListBox1
    .Clear: If ref = "" Then Exit Sub
    .Visible = False
  End With
  For Each F In Worksheets
    If F.Name <> "Menu" And F.Name <> "Ma Cave" Then
      With F
        Set Cel = .Columns("I").Cells.Find(What:=ref, LookIn:=xlValues, lookat:=xlPart)
        If Not Cel Is Nothing Then
          Depart = Cel.Address
          Do
            ajout_liste ListBox1, .Range("A" & Cel.Row).Value, .Range("B" & Cel.Row).Value
            Set Cel = .Columns("I").Cells.FindNext(Cel)
            'If Not Cel Is Nothing Then ajout_liste ListBox1, .Range("A" & Cel.Row).Value Else Exit Do
          Loop While Depart <> Cel.Address        'Or Cel Is Nothing
        End If
      End With
    End If
  Next
  ListBox1.Visible = True
  If ListBox1.ListCount = 0 Then
    MsgBox "Pas trouvé de vin en accord avec " & ref & "", vbCritical
  End If
End Sub

Private Sub ajout_liste(LB As Object, c As String, d As String)
  LB.ListIndex = -1
  On Error Resume Next
  LB.Text = c
  On Error GoTo 0
  If LB.ListIndex = -1 Then
    LB.AddItem c
    LB.List(LB.ListCount - 1, 1) = d
  End If
End Sub

Private Sub UserForm_Initialize()
  With Me.ListBox1
    .ColumnCount = 2
    .ColumnWidths = "100;100"
  End With
End Sub

Voilà le code qui fonctionne pour mon appli, merci beaucoup.

Private Sub CommandButtonRechercheVin_Click()

Dim Cel As Range, Depart As String, ref As String, F As Worksheet

ref = Me.ComboRechercheVin.Text

With Me.ListBox1

.ColumnCount = 2

.Clear: If ref = "" Then Exit Sub

.Visible = False

End With

For Each F In Worksheets

If F.Name <> "Menu" And F.Name <> "Ma Cave" Then

With F

Set Cel = .Columns("I").Cells.Find(What:=ref, LookIn:=xlValues, lookat:=xlPart)

If Not Cel Is Nothing Then

Depart = Cel.Address

Do

ajout_liste ListBox1, .Range("A" & Cel.Row).Value, .Range("B" & Cel.Row).Value

Set Cel = .Columns("I").Cells.FindNext(Cel)

If Not Cel Is Nothing Then ajout_liste ListBox1, .Range("A" & Cel.Row).Value, .Range("B" & Cel.Row).Value Else Exit Do

Loop While Depart <> Cel.Address Or Cel Is Nothing

End If

End With

End If

Next

ListBox1.Visible = True

If ListBox1.ListCount = 0 Then

MsgBox "Pas trouvé de vin en accord avec " & ref & "", vbCritical

End If

End Sub

Private Sub ajout_liste(LB As Object, c As String, d As String)

LB.ListIndex = -1

On Error Resume Next

LB.Text = c

On Error GoTo 0

If LB.ListIndex = -1 Then

LB.AddItem c

LB.List(LB.ListCount - 1, 1) = d

End If

End Sub

Salut, yodjeseb

Serait intéressant de nous mettre un bout de ton fichier avec le code opérationnel pour le voir "fonctionner". ON apprend beaucoup aussi comme ça.

Merci