Trie dans une messagebox

Le 27/01/2022 à 19:10

Bonjour

J'ai un petit programme pour alerter sur le traitement des dossiers en retard. La message box affiche ces derniers dans l'ordre le lecture du tableur.

Ma question est la suivante. Est il possible de trier les information de la message box par ordre alphabetique au sein de la colonne S.

Ainsi, en remplacement de :

Utilisateur 1 : message de retard

Utilisateur 2 : message de retard

Utilisateur 1 : message de retard

J'obtienne :

Utilisateur 1 : message...

Utilisateur 1 : message...

Utilisateur 2 : message

Voici mon code :

Option Explicit
Sub Alertes()

Dim D As Date, LaDate As Date
Dim Lig As Long, P As Long
Dim ListeFinATJM As String, ListeATJM1 As String, sDate As String, ListeCMU As String, ListeCMU2 As String, ListeFinATJM1 As String, ListeFinATJM2 As String, ListeFinATJM3 As String, ListeFinATJM4 As String, Listeanniversaire As String, ListeNote As String, ListeNote1 As String, ListeRegularisation As String, ListeRegularisation2 As String, ListeRegularisation3 As String
Dim Rep As Integer
Dim w1 As Worksheet

Application.ScreenUpdating = False

Set w1 = Worksheets("Effectif")                                     'Feuille qui contient les alertes
    D = Date

    ' ********************************* ATJM à faire
    For Lig = 2 To w1.Range("L" & Rows.Count).End(xlUp).Row

    Select Case w1.Cells(Lig, "Y").Value
            Case "ATJM en attente de décision"
                ListeFinATJM4 = ListeFinATJM4 & vbLf & Cells(Lig, "S").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " est en attente d'une réponse de " & Cells(Lig, "V").Value

        Case Else

            sDate = w1.Range("L" & Lig)
            If IsDate(sDate) Then
                LaDate = DateValue(sDate)
                P = D - LaDate
                If P > -90 And P < 0 Then ListeATJM1 = ListeATJM1 & vbLf & Cells(Lig, "S").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " est à faire pour débuter le " & Cells(Lig, "L").Value
            End If
         End Select
    Next Lig

    ' ********************************* fin d'ATJM
    For Lig = 2 To w1.Range("Z" & Rows.Count).End(xlUp).Row

    Select Case w1.Cells(Lig, "Y").Value

            Case "ATJM non renouvelable"
                ListeFinATJM3 = ListeFinATJM3 & vbLf & Cells(Lig, "S").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " se terminera définitivement le " & Cells(Lig, "Z").Value

            Case "En attente de l'ATJM"
                ListeFinATJM4 = ListeFinATJM4 & vbLf & Cells(Lig, "S").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " est en attente d'une réponse de " & Cells(Lig, "V").Value

            Case Else

                sDate = w1.Range("Z" & Lig)
                If IsDate(sDate) Then
                    LaDate = DateValue(sDate)
                    P = D - LaDate
                    If P >= 0 Then ListeFinATJM3 = ListeFinATJM3 & vbLf & Cells(Lig, "S").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " est expirée depuis le " & Cells(Lig, "Z").Value
                    If P > -60 And P < 0 Then ListeFinATJM = ListeFinATJM & vbLf & Cells(Lig, "S").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " expirera le " & Cells(Lig, "Z").Value

                End If

        End Select

    Next Lig

    ' ********************************* note de 6 mois en retard
    For Lig = 2 To w1.Range("O" & Rows.Count).End(xlUp).Row

    Select Case w1.Cells(Lig, "P").Value

            Case "Oui"

            Case Else

                sDate = w1.Range("O" & Lig)
                If IsDate(sDate) Then
                    LaDate = DateValue(sDate)
                    P = D - LaDate
                    If P >= 0 Then ListeNote = ListeNote & vbLf & Cells(Lig, "S").Value & " : La note en faveur de " & Cells(Lig, "C").Value & " devrait être faite depuis le " & Cells(Lig, "O").Value
                 End If

        End Select

    Next Lig

    ' ********************************* note de 6 mois a venir
    For Lig = 2 To w1.Range("O" & Rows.Count).End(xlUp).Row

    Select Case w1.Cells(Lig, "P").Value

            Case "Oui"

            Case Else

                sDate = w1.Range("O" & Lig)
                If IsDate(sDate) Then
                    LaDate = DateValue(sDate)
                    P = D - LaDate
                    If P > -30 And P < 0 Then ListeNote1 = ListeNote1 & vbLf & Cells(Lig, "S").Value & " : La note en faveur de " & Cells(Lig, "C").Value & " devra être faite pour le " & Cells(Lig, "O").Value
                End If

        End Select

    Next Lig

    ' ********************************* fin de CMU
    For Lig = 2 To w1.Range("AE" & Rows.Count).End(xlUp).Row
        sDate = w1.Range("AE" & Lig)

        If IsDate(sDate) Then
            LaDate = DateValue(sDate)
            P = D - LaDate
            If P >= 0 Then ListeCMU = ListeCMU & vbLf & "La CMU pour " & Cells(Lig, "C").Value & " est expirée depuis le " & Cells(Lig, "AE")
            If P > -30 And P < 0 Then ListeCMU2 = ListeCMU2 & vbLf & "La CMU pour " & Cells(Lig, "C").Value & " expirera le " & Cells(Lig, "AE").Value
        End If

    Next Lig

    ' ********************************* Regularisation
    For Lig = 2 To w1.Range("L" & Rows.Count).End(xlUp).Row

        Select Case w1.Cells(Lig, "AS").Value

            Case Is <> ""
                ListeRegularisation3 = ListeRegularisation3 & vbLf & Cells(Lig, "S").Value & " : La demande de titre de séjour pour " & Cells(Lig, "C").Value & " a été réalisée"    'ici le code prévu à cet effet ou rien

            Case Else
                sDate = w1.Range("L" & Lig)
                If IsEmpty(w1.Range("AS" & Lig)) Then
                    If IsDate(sDate) Then
                        LaDate = DateValue(sDate)
                        P = D - LaDate
                        If P >= 0 Then ListeRegularisation = ListeRegularisation & vbLf & Cells(Lig, "S").Value & " : La demande de titre de séjour pour " & Cells(Lig, "C").Value & " devrait être réalisée depuis depuis le " & Cells(Lig, "L").Value
                        If P > -90 And P < 0 Then ListeRegularisation2 = ListeRegularisation2 & vbLf & Cells(Lig, "S").Value & " : La demande de titre de séjour pour " & Cells(Lig, "C").Value & " devra être réalisée avant le " & Cells(Lig, "L").Value
                    End If
                End If

        End Select

    Next Lig

    ' ********************************* Messagebox
    Rep = MsgBox(ListeNote, vbExclamation + vbOKCancel, "Note en retard")
    If Rep = vbCancel Then Exit Sub

    Rep = MsgBox(ListeNote1, vbExclamation + vbOKCancel, "Note à faire")
    If Rep = vbCancel Then Exit Sub

    Rep = MsgBox(ListeATJM1, vbExclamation + vbOKCancel, "ATJM à faire")
    If Rep = vbCancel Then Exit Sub

    Rep = MsgBox(ListeFinATJM, vbExclamation + vbOKCancel, "ATJM à renouveler")
    If Rep = vbCancel Then Exit Sub

    Rep = MsgBox(ListeFinATJM3, vbExclamation + vbOKCancel, "ATJM se terminant définitivement ou en retard")
    If Rep = vbCancel Then Exit Sub

    Rep = MsgBox(ListeFinATJM4, vbExclamation + vbOKCancel, "ATJM en attente de réponse")
    If Rep = vbCancel Then Exit Sub

    Rep = MsgBox(ListeRegularisation2, vbExclamation + vbOKCancel, "Demande titre de séjour à faire")
    If Rep = vbCancel Then Exit Sub

    Rep = MsgBox(ListeRegularisation, vbExclamation + vbOKCancel, "Demande titre de séjour en retard")
    If Rep = vbCancel Then Exit Sub

    Rep = MsgBox("Voulez-vous envoyer un mail de rappel aux éducateur ?", vbExclamation + vbYesNoCancel, "Régularisation")
    If Rep = vbYes Then
    Call Mail_educateur

        Else

    If Rep = vbCancel Then Exit Sub        ' ...
    End If

    Rep = MsgBox(ListeCMU, vbExclamation + vbOKCancel, "liste des CMU expirées")
    If Rep = vbCancel Then Exit Sub

    Rep = MsgBox(ListeCMU2, vbExclamation + vbOKCancel, "liste des CMU en fin de droit")
    If Rep = vbCancel Then Exit Sub

    Rep = MsgBox("Voulez-vous envoyer un mail de demande aux AG ?", vbExclamation + vbYesNoCancel, "Réclamation")
    If Rep = vbYes Then
    Call Mail_AG

        Else

    Call Anniversaires

    End If

Application.ScreenUpdating = True 'Facultatif

End Sub

Merci pour l'ensemble de votre aide

Le 28/01/2022 à 06:25

Bonjour,

Au lieu d'incrémenter vos messages dans des variables string, utilisez une variable tableau pour l'ensemble que vous pourrez trier ensuite. Pour vous familiariser avec l'utilisation de ces variables, regardez déjà ce qu'a écrit Jacques BOISGONTIER sur ce sujet dans son chapitre : Tableaux VBA (Array)

Dans votre cas, il vous faut sans doute une variable à 2 dimensions.

Le 28/01/2022 à 18:24

Bonjour

Je m'y penche.

Rechercher des sujets similaires à "trie messagebox"