XL 2019 Organiser les données dans listbox

Messan

XLDnaute Junior
Salut les couronnés. Je vous crois en parfaite forme.

Je viens à vous pour solliciter votre aide. j'ai un fichier excel vba. dans l'un de mes listbox, je n'arrive pas à bien disposer en colonne les données. le code est dans "USF_Présence" et mon problème conserne l'affichache dans "Lbx_Elèves".

Capture d'écran 2023-12-02 152428.png


Je veux que ca s'affiche comme dans ce listbox en exemple :
Capture d'écran 2023-12-02 152645.png



Voici le code du fichier :

Public wsEns As Worksheet

Private Sub Cbn_AjouterDate_Click()
Application.Calculation = xlCalculationManual
If Me.Lbx_Enseignants.ListIndex = -1 Then
MsgBox "Veuillez d'abord sélectionner un établissement scolaire"
GoTo fin
End If
If Me.Tbx_DateDemande = "" Then Exit Sub
If MsgBox("Souhaitez-vous ajouter la date " & Me.Tbx_DateDemande & " au tableau?", vbYesNo) = vbNo Then Exit Sub
With wsEns.ListObjects(1)
Set trouve = .HeaderRowRange.Find(Me.Tbx_DateDemande)
If Not trouve Is Nothing Then
MsgBox ("Cette date est déjà dans le tableau")
GoTo fin

End If
' Ajouter un colonnes
.ListColumns.Add
.HeaderRowRange(.ListColumns.Count) = Me.Tbx_DateDemande
End With
LoadCbx "Cbx_Dates", wsEns
Me.Cbx_Dates = Me.Tbx_DateDemande
fin:
Me.Tbx_DateDemande = ""
Application.Calculation = xlCalculationAutomatic
End Sub

Private Sub Cbn_Quitter_Click()
Unload Me
End Sub

Private Sub Cbn_SupprimerDate_Click()
Application.Calculation = xlCalculationManual

If Me.Cbx_Dates.ListIndex = -1 Then Exit Sub
If MsgBox("Souhaitez-vous supprimer la date " & Me.Cbx_Dates & " du tableau?", vbYesNo) = vbNo Then Exit Sub

With wsEns.ListObjects(1)
Set trouve = .HeaderRowRange.Find(Me.Cbx_Dates)
If trouve Is Nothing Then Exit Sub
col = trouve.Column
' Supprimer la colonne de la date
.ListColumns(col).Delete
' Vérifier si la colonne "Observation" existe
If col <= .ListColumns.Count Then
' Si la colonne suivante contient "Observation", la supprimer
If InStr(1, .HeaderRowRange(col).Value, "Observation") > 0 Then
.ListColumns(col).Delete
End If
End If
End With
LoadCbx "Cbx_Dates", wsEns
Me.Cbx_Dates.ListIndex = -1
Application.Calculation = xlCalculationAutomatic

End Sub

Private Sub Cbn_Valider_Click()
Dim nb As Integer, y As Integer, lig As Integer, x As Integer
Dim reponse As VbMsgBoxResult
Application.ScreenUpdating = False
If Me.Cbx_Dates.ListIndex = -1 Then
MsgBox "Veuillez sélectioner une date"
Exit Sub
End If
Ctrl = True
With wsEns.ListObjects(1)
Set trouve = .HeaderRowRange.Find(Me.Cbx_Dates)
If trouve Is Nothing Then Exit Sub
col = trouve.Column
For i = 0 To Me.Lbx_Elèves.ListCount - 1
If Me.Cbx_Classe.Value = "" Then
MsgBox "Veuillez renseigner la Classe"
Exit Sub
Else
' Vérifier si la cellule contient déjà des données
If .DataBodyRange(i + 1, col) <> "" And Me.Lbx_Elèves.Selected(i) Then
' Demander à l'utilisateur s'il veut remplacer les données existantes
reponse = MsgBox("L'élève " & .DataBodyRange(i + 1, 3).Value & " est dans " & .DataBodyRange(i + 1, col).Value & ". Voulez-vous modifier?", vbYesNo)
If reponse = vbYes Then
.DataBodyRange(i + 1, col) = Me.Cbx_Classe.Value
End If
ElseIf .DataBodyRange(i + 1, col) = "" And Me.Lbx_Elèves.Selected(i) Then
.DataBodyRange(i + 1, col) = Me.Cbx_Classe.Value
End If
End If
nb = 0
For y = col To 7 Step -1
If .DataBodyRange(i + 1, y) = "A" Then
nb = nb + 1
Else
Exit For
End If
Next y
Next i
End With
Ctrl = False
Sheets("ACCUEIL").Activate
Application.ScreenUpdating = True
End Sub


Private Sub Cbx_Dates_Change() 'quand on selectionne une date==> on selectionne les élèves présents
With wsEns.ListObjects(1)
Set trouve = .HeaderRowRange.Find(Me.Cbx_Dates)
If trouve Is Nothing Then Exit Sub
col = trouve.Column

For i = 1 To .ListRows.Count
Me.Lbx_Elèves.Selected(i - 1) = .DataBodyRange(i, col) <> ""
Next i
End With

End Sub


Private Sub CommandButton1_Click()
If Me.Cbx_Motif.ListIndex = -1 Then
MsgBox "Veuillez sélectioner une Année Scolaire"
Exit Sub
End If

Cbx_Motif.Text = ""
' Appeler la procédure LoadListBox pour charger la liste complète des élèves
LoadListBox "Lbx_Elèves", wsEns
End Sub


Private Sub Lbx_Enseignants_Click() 'quand on selectionne un enseignant ==> sa classe est chargée
If Me.Lbx_Enseignants.ListIndex = -1 Then Exit Sub
Enseignant = Me.Lbx_Enseignants
Set wsEns = Sheets(Enseignant)
LoadListBox "Lbx_Elèves", wsEns
LoadCbx "Cbx_Dates", wsEns
End Sub


Private Sub UserForm_Initialize()
Dim classes As Variant
Dim i As Integer
Dim j As Integer

' Liste des classes
classes = Array("CI", "CP1", "CP2", "CE1", "CE2", "CM1", "CM2", "Sixième", "Cinquième", "Quatrième", "Troisième", "Seconde", "Première", "Terminale", "F1", "F2", "F3", "F4", "G1", "G2", "G3")

Me.Lbx_Enseignants.Clear 'on vide la listbox
With Sheets("Feuil3").ListObjects("t_Enseignants") 'avec la table de la feuille Feuil3
'Boucle pour charger les enseignants dans la Listbox
For i = 1 To .ListRows.Count 'pour chaque ligne
Me.Lbx_Enseignants.AddItem .DataBodyRange(i).Value
Next i
End With


With Me.Tbx_DateDemande
.AddItem "2022-2023"
.AddItem "2023-2024"
.AddItem "2024-2025"
.AddItem "2025-2026"
.AddItem "2026-2027"
.AddItem "2027-2028"
.AddItem "2028-2029"
.AddItem "2029-2030"
.AddItem "2030-2031"
.AddItem "2031-2032"
.AddItem "2032-2033"
.AddItem "2033-2034"
.AddItem "2034-2035"
.AddItem "2035-2036"
.AddItem "2036-2037"
.AddItem "2037-2038"
.AddItem "2038-2039"
.AddItem "2039-2040"
.AddItem "2040-2041"
.AddItem "2041-2042"
.AddItem "2042-2043"
.AddItem "2043-2044"
.AddItem "2044-2045"
.AddItem "2045-2046"
.AddItem "2046-2047"
.AddItem "2047-2048"
.AddItem "2048-2049"
.AddItem "2049-2050"
End With

' Ajouter les classes à la combobox
For i = LBound(classes) To UBound(classes)
Me.Cbx_Classe.AddItem classes(i)
Next i

' Ajouter les classes à la combobox
For i = LBound(classes) To UBound(classes)
Me.Cbx_Motif.AddItem classes(i)
Next i


Me.Cbx_Classe.ListIndex = -1
End Sub

Sub LoadListBox(NomList As String, NomFeuille As Worksheet) 'permet de charger les élèves du tableau dans la listbox
If Me.Lbx_Enseignants.ListIndex = -1 Then
MsgBox "Veuillez sélectioner un Etablissement Scolaire"
Exit Sub
Else
Me.Controls(NomList).Clear
With NomFeuille.ListObjects(1)
For i = 1 To .ListRows.Count
Dim lastCellValue As String
' Parcourir les colonnes à partir de la colonne 7
For j = 7 To .ListColumns.Count
If .ListColumns(j).DataBodyRange(i) <> "" Then
lastCellValue = .ListColumns(j).DataBodyRange(i)
End If
Next j
Dim nomPrenom As String
nomPrenom = .ListColumns("NOM & PRENOMS").DataBodyRange(i)
' Ajouter des éléments à ListBox
Dim item As String
If Len(nomPrenom) <= 10 Then
item = nomPrenom & Space(30 - Len(nomPrenom)) & lastCellValue
Else
item = nomPrenom & Space(30) & lastCellValue
End If
Me.Controls(NomList).AddItem item
Next i
End With
End If
End Sub

Sub LoadCbx(NomCombo As String, NomFeuille As Worksheet) 'permet de charger les dates du tableau dans le combo
Dim colName As String
Me.Controls(NomCombo).Clear
With NomFeuille.ListObjects(1)
For j = 7 To .ListColumns.Count
colName = .HeaderRowRange(j).Value
' Si le nom de la colonne ne contient pas "Observation", l'ajouter à la combobox
If InStr(1, colName, "Observation") = 0 Then
Me.Controls(NomCombo).AddItem colName
End If
Next j
End With
End Sub


Private Sub Cbx_Motif_Change()
Dim i As Long, j As Long
Dim ws As Worksheet
Dim lastColumn As Long
Dim lastCell As String

' Vérifier si un établissement scolaire a été sélectionné
If Me.Lbx_Enseignants.ListIndex = -1 Then
MsgBox "Veuillez sélectioner un Etablissement Scolaire"
Exit Sub
End If

' Effacer tous les éléments de la ListBox
Lbx_Elèves.Clear

' Parcourir tous les établissements scolaires listés dans Lbx_Enseignants
For j = 0 To Me.Lbx_Enseignants.ListCount - 1
' Définir la feuille de calcul pour l'établissement scolaire
Set ws = Sheets(Me.Lbx_Enseignants.List(j))

' Parcourir toutes les lignes de la feuille de calcul
For i = 2 To ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
' Trouver la dernière cellule non vide à partir de la colonne 7
lastColumn = ws.Cells(i, 7).End(xlToRight).Column
lastCell = ws.Cells(i, lastColumn).Value

' Si la valeur de la dernière cellule non vide correspond au motif sélectionné, ajouter l'élève à la ListBox
If lastCell = Cbx_Motif.Value Then
Lbx_Elèves.AddItem ws.Cells(i, "C").Value
End If
Next i
Next j
End Sub

Private Sub Lbx_Enseignants_Change()
' Réinitialiser Cbx_Motif lorsque l'établissement scolaire change
Cbx_Motif.Text = ""
End Sub

Sub SetListBoxColumnWidths()
Dim i As Long, j As Long
Dim ws As Worksheet
Dim temp As String

' Parcourir tous les établissements scolaires listés dans Lbx_Enseignants
For j = 0 To Me.Lbx_Enseignants.ListCount - 1
' Définir la feuille de calcul pour l'établissement scolaire
Set ws = Sheets(Me.Lbx_Enseignants.List(j))

' Parcourir toutes les colonnes de la feuille de calcul à partir de la colonne 7
For i = 7 To ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
' Ajouter la largeur de la colonne à la chaîne temp
temp = temp & ws.Columns(i).Width * 0.9 & ";"
Next i
Next j

' Définir la largeur des colonnes de la ListBox
Lbx_Elèves.ColumnWidths = temp
End Sub

Fichier en PJ: classe 2

 

Pièces jointes

  • Classe 2.xlsm
    408.7 KB · Affichages: 6
Solution
Bonjour,

Le plus simple est de mettre deux colonnes a votre listbox
Sinon, prendre une police de caractere a espacement fixe comme Courrier, Courrier New
avec cette modif
VB:
                ' Ajouter des éléments à ListBox
                Dim item As String
                item = nomPrenom & Space(30 - Len(nomPrenom)) & lastCellValue
                Me.Controls(NomList).AddItem item

Oneida

XLDnaute Impliqué
Bonjour,

Le plus simple est de mettre deux colonnes a votre listbox
Sinon, prendre une police de caractere a espacement fixe comme Courrier, Courrier New
avec cette modif
VB:
                ' Ajouter des éléments à ListBox
                Dim item As String
                item = nomPrenom & Space(30 - Len(nomPrenom)) & lastCellValue
                Me.Controls(NomList).AddItem item
 
Dernière édition:

Messan

XLDnaute Junior
Bonjour,

Le plus simple est de mettre deux colonnes a votre listbox
Sinon, prendre une police de caractere a espacement fixe comme Courrier, Courrier New
avec cette modif
VB:
                ' Ajouter des éléments à ListBox
                Dim item As String
                item = nomPrenom & Space(30 - Len(nomPrenom)) & lastCellValue
                Me.Controls(NomList).AddItem item
Merci beaucoup mon grand. Ca a marché. Encore merci
 

Discussions similaires

Statistiques des forums

Discussions
312 561
Messages
2 089 667
Membres
104 251
dernier inscrit
casino.macon