piga25
XLDnaute Barbatruc
Bonjour,
J'ai un problème de compréhension avec les codes de BOISGONTIER.
Lorsque j'ai moins de 4 lignes dans la base cela bug.
Je pense que cela vient de cette ligne dans initialize : NbCol = UBound(TblBD, 1) -1
De plus lorsqu'il y a aucune donnée dans les bases, il y a un problème d'affichage dans les listbox. Il faudrait qu'elle soit vide et que le premier item ajouté vienne bien sur la première ligne.
J'ai un problème de compréhension avec les codes de BOISGONTIER.
Lorsque j'ai moins de 4 lignes dans la base cela bug.
Je pense que cela vient de cette ligne dans initialize : NbCol = UBound(TblBD, 1) -1
De plus lorsqu'il y a aucune donnée dans les bases, il y a un problème d'affichage dans les listbox. Il faudrait qu'elle soit vide et que le premier item ajouté vienne bien sur la première ligne.
VB:
Option Compare Text
Dim Rng, TblBD(), NbCol, ligneEnreg
Private Sub UserForm_Initialize()
MultiPage1.Value = 0
Set f = Sheets("Annuaire")
'Alimente comboBox1
a = f.Range("P2:P" & f.[P65000].End(xlUp).Row).Value
Set AL = CreateObject("System.Collections.Arraylist")
For i = LBound(a) To UBound(a)
If Not AL.contains(a(i, 1)) Then AL.Add a(i, 1) 'enlève les doublons des n° d'équipe
Next i
AL.Sort
Me.ComboBox1.List = AL.toarray
Set AL = Nothing
'Alimente listBox1: Liste du planning
a = f.Range("F2:I" & f.[F65000].End(xlUp).Row).Value
ReDim b(LBound(a) To UBound(a), LBound(a, 2) To UBound(a, 2))
Set SL = CreateObject("System.Collections.Sortedlist")
For i = LBound(a) To UBound(a)
SL.Add a(i, 1), Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4)) 'Tri sur le n° de planning
Next i
Set AL = CreateObject("System.Collections.Arraylist")
AL.AddRange SL.Values
Me.ListBox1.Column = Application.Transpose(AL.toarray)
Set SL = Nothing
Set AL = Nothing
'Alimente ListBox2: Liste des équipes
a = f.Range("P2:T" & f.[P65000].End(xlUp).Row).Value
ReDim b(LBound(a) To UBound(a), LBound(a, 2) To UBound(a, 2))
Set SL = CreateObject("System.Collections.Sortedlist")
For i = LBound(a) To UBound(a)
SL.Add a(i, 1) & a(i, 2), Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4), a(i, 5))
Next i
Set AL = CreateObject("System.Collections.Arraylist")
AL.AddRange SL.Values
Me.ListBox2.Column = Application.Transpose(AL.toarray)
Me.ListBox5.Column = Application.Transpose(AL.toarray)
Me.ListBox9.Column = Application.Transpose(AL.toarray)
Set SL = Nothing
Set AL = Nothing
'Alimente ListBox3: Liste de l'équipe sélectionnée
Set Rng = f.Range("P2:T" & f.[P65000].End(xlUp).Row)
TblBD = Rng.Value
NbCol = UBound(TblBD, 1) - 1 '*** Ligne posant problème**Si moins de 4 lignes dans la base
Set d = CreateObject("scripting.dictionary")
d("*") = "" 'affiche la liste complète à l'initialyse
For i = 1 To UBound(TblBD, 1): d(TblBD(i, 1)) = "": Next i
Me.ComboBox1.List = d.keys
Me.ComboBox1 = "*"
Me.ListBox3.ColumnCount = NbCol
Me.ListBox6.ColumnCount = NbCol
Affiche
Set Rng = Nothing
Set d = Nothing
End Sub
Private Sub ComboBox1_click()
Affiche
End Sub
Sub Affiche() ' Ne retient que l'équipe recherchée
n = 0
Dim TblDest()
Equipe = Me.ComboBox1
For i = 1 To UBound(TblBD)
If TblBD(i, 1) Like Equipe Then
n = n + 1: ReDim Preserve TblDest(1 To UBound(TblBD, 1), 1 To n)
For k = 1 To NbCol: TblDest(k, n) = TblBD(i, k): Next k
End If
Next i
Me.ListBox3.Column = TblDest
'---Tri par équipe
a = Me.ListBox3.List
Tri a, LBound(a), UBound(a), 0
Me.ListBox3.List = a
Me.ListBox7.List = a
Me.ListBox8.List = a
Me.TextBox16 = Me.ComboBox1
Me.TextBox17 = Me.TextBox1
If Me.ComboBox1 <> "*" Then
Me.CommandButton16.Visible = True
Else
Me.CommandButton16.Visible = False
End If
End Sub
Sub Tri(a, gauc, droi, colTri) ' Quick sort
colD = LBound(a, 2): colG = UBound(a, 2)
ref = a((gauc + droi) \ 2, colTri)
g = gauc: d = droi
Do
Do While a(g, colTri) < ref: g = g + 1: Loop
Do While ref < a(d, colTri): d = d - 1: Loop
If g <= d Then
For c = colD To colG
Temp = a(g, c): a(g, c) = a(d, c): a(d, c) = Temp
Next
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(a, g, droi, colTri)
If gauc < d Then Call Tri(a, gauc, d, colTri)
End Sub
Dernière édition:
