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".
Je veux que ca s'affiche comme dans ce listbox en exemple :
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
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".
Je veux que ca s'affiche comme dans ce listbox en exemple :
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
