Tri dans combobox

maxou · Août 19, 2022, 11:11

Salut a tous,
J’ai besoin d’un coup de main :

j’essai de faire un tri alphabétique dans une combobox, j’ai fait une fonction pour ça mais le problème c’est que quand je fais un choix dans la liste déroulante de la combobox il prend l’index en compte et non le nom, du coup en choisissant un nom je me retrouve avec des informations différentes que celles attendus

Voici la fonction pour trier la combo box, les noms apparaissent bien par ordre alphabétique.

Function ListSort(liSte)
  

 Dim First As Integer, Last As Integer
 Dim i As Integer, j As Integer
 Dim temp

 First = LBound(liSte)
  Last = UBound(liSte)
  For i = First To Last - 1
    For j = i + 1 To Last
      If liSte(i, 0) > liSte(j, 0) Then
        temp = liSte(j, 0)
        liSte(j, 0) = liSte(i, 0)
        liSte(i, 0) = temp
      End If
    Next j
  Next i
 ListSort = liSte
 End Function

Déclaration de ma combobox

Private Sub UserForm_Initialize()

Dim j As Long
Dim i As Integer
Dim k As Integer
Dim ws As Worksheet

Set ws = Sheets("patient")

With Me.ComboBox1
    For j = 2 To ws.range("B" & Rows.Count).End(xlUp).Row
        .AddItem ws.range("B" & j)
    Next j
 End With

 For k = 1 To 7
    Me.Controls("TextBox" & k).Visible = True
 Next k
 
Me.ComboBox1.List = ListSort(Me.ComboBox1.List)
End Sub

Gestion de la combobox
Pour l’instant j’ai mis en place en tri avant l’affichage de la liste mais c’est long, cette solution me parait bancale.

Private Sub ComboBox1_Change()

Dim Ligne As String
Dim i As Integer
Dim tbl As ListObject

Set tbl = ws.ListObjects(1)

Columns("A:I").Select
    ActiveWorkbook.Worksheets("patient").ListObjects("table").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("patient").ListObjects("table").Sort.SortFields.Add2 _
        Key:=range("table[Nom prénom]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("patient").ListObjects("table").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
If Me.ComboBox1.ListIndex = -1 Then Exit Sub
    Ligne = Me.ComboBox1.ListIndex + 2
   For i = 1 To 7
    Me.Controls("TextBox" & i) = ws.Cells(Ligne, i + 2)
   Next i
End Sub

beta.xlsm (31,0 Ko)

Mimimathy · Août 19, 2022, 4:38

Bonjour,

maxou · Août 19, 2022, 5:43

salut mimimathy
c’est fait
j’ai un peu modifié le « sort » c’est beaucoup plus rapide qu’avant mais je ne pense toujours pas que ce soit l’idéal

Mimimathy · Août 20, 2022, 4:16

Re,
Voici les macros pour initialiser l’userform avec tri alpha des noms pour le combobox et l’affichage sur les textbox

Option Explicit
Dim ws As Worksheet

'Pour le formulaire
Private Sub UserForm_Initialize()
  Dim temp()
  Set ws = Sheets("patient")
  temp = Application.Transpose(ws.Range("B2:B" & ws.[B65000].End(xlUp).Row))
  Tri temp, LBound(temp), UBound(temp)
  Me.ComboBox1.List = temp
End Sub

Sub Tri(a(), gauc, droi) ' Quick sort
Dim ref$, g, d, temp
   ref = a((gauc + droi) \ 2)
   g = gauc: d = droi
   Do
     Do While a(g) < ref: g = g + 1: Loop
     Do While ref < a(d): d = d - 1: Loop
     If g <= d Then
       temp = a(g): a(g) = a(d): a(d) = temp
       g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

Private Sub ComboBox1_Change()
Dim Ligne%, i%
Ligne = Application.Match(Me.ComboBox1, Columns(2), 0)
  For i = 1 To 7
    Me.Controls("TextBox" & i) = ws.Cells(Ligne, i + 2)
   Next i
End Sub

Mimimathy · Août 20, 2022, 5:25

Il fut un temps ou j’avais fait un exercice avec ce genre de programme
je te le place en lien

maxou · Août 22, 2022, 12:53

Salut mimimathy,
merci beaucoup pour le retour mais j’ai une incompatibilité de type sur la ligne

Ligne = Application.Match(Me.ComboBox1, Columns(2), 0)

maxou · Août 22, 2022, 12:55

La variable Ligne contient la valeur 0 peut importe le choix dans la combobox

maxou · Août 22, 2022, 1:10

Re,
J’ai trouvé le problème, il manquait l’indication de la feuille pour la colonne.

Un grand merci ca marche parfaitement.

maxou · Août 25, 2022, 1:01

Bonjour mimimathy,
J’ai une question :

lorsque je réplique le private sub combobox_change je me retrouve avec une erreur sur la ligne

ActiveWorkbook.Worksheets(« feuille2 »).AutoFilter.Sort.SortFields.Clear

disant:
erreur ‹ 91 ›
variable ibjet ou variable de bloc with non défini

alors que sur le premier je n’ai pas d’erreur et qu’il s’agit d’un copié collé adapté a une autre combobox

CODE:

Private Sub UserForm_Initialize()

Dim j As Long
Dim i As Integer
Dim k As Integer
Set ws = Sheets("patient")
Set wp = Sheets("presta")

With Me.ComboBox1
    For j = 2 To ws.range("A" & Rows.Count).End(xlUp).Row
        .AddItem ws.range("A" & j)
    Next j
 End With

 For k = 1 To 7
    Me.Controls("TextBox" & k).Visible = True
 Next k
 
Me.ComboBox1.List = ListSort(Me.ComboBox1.List)

With Me.ComboBox2
    For j = 2 To wp.range("A" & Rows.Count).End(xlUp).Row
        .AddItem wp.range("A" & j)
    Next j
 End With

 For k = 1 To 7
    Me.Controls("TextBox" & k).Visible = True
 Next k
 
Me.ComboBox2.List = ListSort(Me.ComboBox2.List)


End Sub

Public Function ListSort(liSte)
  

 Dim First As Integer, Last As Integer
 Dim i As Integer, j As Integer
 Dim temp

 First = LBound(liSte)
  Last = UBound(liSte)
  For i = First To Last - 1
    For j = i + 1 To Last
      If liSte(i, 0) > liSte(j, 0) Then
        temp = liSte(j, 0)
        liSte(j, 0) = liSte(i, 0)
        liSte(i, 0) = temp
      End If
    Next j
  Next i
 ListSort = liSte
 End Function


'Pour la liste déroulante Code client
Private Sub ComboBox1_Change()

Dim Ligne As String
Dim i As Integer
Dim tbl As ListObject

Set ws = Sheets("patient")


    ActiveWorkbook.Worksheets("patient").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("patient").AutoFilter.Sort.SortFields.Add2 Key:= _
        range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("patient").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    
If Me.ComboBox1.ListIndex = -1 Then Exit Sub
    Ligne = Me.ComboBox1.ListIndex + 2
   For i = 1 To 7
    Me.Controls("TextBox" & i) = ws.Cells(Ligne, i + 1)
   Next i
 
End Sub


Private Sub ComboBox2_Change()

Dim Ligne As String
Dim i As Integer
Dim tbl As ListObject

Set wp = Sheets("presta")


    ActiveWorkbook.Worksheets("presta").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("presta").AutoFilter.Sort.SortFields.Add2 Key:= _
        range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal


    With ActiveWorkbook.Worksheets("presta").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    
If Me.ComboBox2.ListIndex = -1 Then Exit Sub
    Ligne = Me.ComboBox2.ListIndex + 2
   For i = 8 To 12
    Me.Controls("TextBox" & i) = wp.Cells(Ligne, i + 2)
   Next i
 
End Sub

Mimimathy · Août 25, 2022, 1:29

Bonjour,
Et je suis censé deviner ce qu’il y a dans la feuille « presta » pour alimenter un combobox2 qui se trouve dans un userform que je ne peut voir

maxou · Août 25, 2022, 1:59

testtemplate -xx.xlsm (39,4 Ko)
oups voici le fichier

Mimimathy · Août 25, 2022, 2:22

Re,
A tester
testtemplate -xx.xlsm (27,4 Ko)

system · Septembre 24, 2022, 2:22

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.