Saut dans un array de liste
A
Bonjour,
Votre macro modifiée:
'11-GROUPE ET classe
Private Sub ETclasApr_Click()
'emploi du temps du prof suivant dans ongl matsProfs
Dim i%, j%, k%, ws1 As Worksheet, ws2 As Worksheet, list1 As Variant, list2 As Variant
Application.ScreenUpdating = False
Set ws1 = Sheets("ETecol") 'profs
Set ws2 = Sheets("ETelev") 'matières
'liste des classes
list1 = Array("CP1", "CP2", "CE1", "CE2", "CM1", "CM2")
list2 = Array("A", "B", "C")
For i = 0 To UBound(list1)
For j = 0 To UBound(list2)
On Error Resume Next
If Me.ETclas.Value = list1(i) & list2(2) Then
Me.ETclas.Value = list1(i + 1) & list2(0)
GoTo Liste
If Err.Number <> 0 Then Exit Sub
ElseIf Me.ETclas.Value = list1(i) & list2(j) Then
Me.ETclas.Value = list1(i) & list2(j + 1)
Exit For
End If
Next j
Next i
Liste:
'efface les listes
Me.LstPrfs.Clear
Me.LstMats.Clear
'Affichage listes
For i = 1 To 126 Step 7 'lignes prof
If ws1.Cells(i, 1).Value = Me.ETclas.Value Then
For k = i + 1 To i + 6
For j = 2 To 6 'cols prof
'si jour et horaire ok
'affichage classes selon horaires
Me.LstPrfs.AddItem
Me.LstPrfs.list(Me.LstPrfs.ListCount - 1, 0) = ws1.Cells(k, 1).Value 'horaires
Me.LstPrfs.list(Me.LstPrfs.ListCount - 1, 1) = ws1.Cells(k, 2).Value 'lundi
Me.LstPrfs.list(Me.LstPrfs.ListCount - 1, 2) = ws1.Cells(k, 3).Value
Me.LstPrfs.list(Me.LstPrfs.ListCount - 1, 3) = ws1.Cells(k, 4).Value
Me.LstPrfs.list(Me.LstPrfs.ListCount - 1, 4) = ws1.Cells(k, 5).Value
Me.LstPrfs.list(Me.LstPrfs.ListCount - 1, 5) = ws1.Cells(k, 6).Value 'vendredi
'affichage matieres selon horaires
Me.LstMats.AddItem
Me.LstMats.list(Me.LstMats.ListCount - 1, 0) = ws2.Cells(k, 1).Value 'horaires
Me.LstMats.list(Me.LstMats.ListCount - 1, 1) = ws2.Cells(k, 2).Value 'lundi
Me.LstMats.list(Me.LstMats.ListCount - 1, 2) = ws2.Cells(k, 3).Value
Me.LstMats.list(Me.LstMats.ListCount - 1, 3) = ws2.Cells(k, 4).Value
Me.LstMats.list(Me.LstMats.ListCount - 1, 4) = ws2.Cells(k, 5).Value
Me.LstMats.list(Me.LstMats.ListCount - 1, 5) = ws2.Cells(k, 6).Value 'vendredi
GoTo there
Next j
there:
Next k
End If
Next i
'larg cols liste et 1ere ligne sélectionnee
If Me.LstMats.ListCount <> 0 Then
Me.LstPrfs.ColumnWidths = "60;96;96;96;96;96" 'largeur cols listbox
Me.LstMats.ColumnWidths = "60;96;96;96;96;96" 'largeur cols listbox
End If
fin:
Application.ScreenUpdating = True
End SubCdlt
Bonjourr Arturo,
Merci pour ta réponse.
Faiblard l'exit for donc
GoTo Liste
If Err.Number <> 0 Then Exit Sub