Msgbox selon utilisateur

Le 06/02/2022 à 19:51

Bonsoir

j'utilise le code suivant qu'un utilisateur de ce forum m'a gentiment créé

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

On Error GoTo GestionErreur

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, "AA").Value

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

            Case "ATJM non renouvelable"
            ListeFinATJM3 = ListeFinATJM3 & vbLf & Cells(Lig, "U").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " se terminera définitivement le " & Cells(Lig, "AB").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, "U").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " est à faire pour débuter le " & Cells(Lig, "L").Value
            End If

            sDate = w1.Range("AB" & Lig)
            If IsDate(sDate) Then
                 LaDate = DateValue(sDate)
                 P = D - LaDate
                 If P >= 0 Then ListeFinATJM3 = ListeFinATJM3 & vbLf & Cells(Lig, "U").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " est expirée depuis le " & Cells(Lig, "AB").Value
                 If P > -60 And P < 0 Then ListeFinATJM = ListeFinATJM & vbLf & Cells(Lig, "U").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " expirera le " & Cells(Lig, "AB").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, "U").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, "U").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("AG" & Rows.Count).End(xlUp).Row
        sDate = w1.Range("AG" & 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, "AG")
            If P > -30 And P < 0 Then ListeCMU2 = ListeCMU2 & vbLf & "La CMU pour " & Cells(Lig, "C").Value & " expirera le " & Cells(Lig, "AG").Value
        End If

    Next Lig

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

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

            Case Is <> ""
                ListeRegularisation3 = ListeRegularisation3 & vbLf & Cells(Lig, "U").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, "U").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, "U").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

Exit Sub

GestionErreur:
    MsgBox "Une erreur s'est produite. Fin de la procédure"
    Exit Sub

Application.ScreenUpdating = True 'Facultatif

End Sub

je voudrais qu'à l'ouverture dudit fichier, la msgbox n'affiche que les lignes dont l'utilisateur Environ("username") est celui indiqué en colonne U. J'i compris comment faire une vba à l'ouverture qui appellera la vba des listes, mais je n'arrive pas à juste sélectionner l'utilisateur.

Merci d'avance.

Le 07/02/2022 à 00:57

bonjour,

tu ajoutes un test If w1.cells(lig,"U") = Environ("username") Then

juste après chaque instruction For Lig = ....

et tu mets un End If avant chaque instruction Next Lig

Le 08/02/2022 à 15:02

Bonjour

En faisant ainsi :

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

'On Error GoTo GestionErreur

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

If w1.Cells(Lig, "U") = Environ("username") Then

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

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

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

            Case "ATJM non renouvelable"
            ListeFinATJM3 = ListeFinATJM3 & vbLf & Cells(Lig, "U").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " se terminera définitivement le " & Cells(Lig, "AB").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, "U").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " est à faire pour débuter le " & Cells(Lig, "L").Value
            End If

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

    End Select

    Next Lig

End If

    ' ********************************* note de 6 mois en retard
If w1.Cells(Lig, "U") = Environ("username") Then

    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, "U").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

End If

    ' ********************************* note de 6 mois a venir
If w1.Cells(Lig, "U") = Environ("username") Then

    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, "U").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

End If

    ' ********************************* fin de CMU
If w1.Cells(Lig, "U") = Environ("username") Then

    For Lig = 2 To w1.Range("AG" & Rows.Count).End(xlUp).Row
        sDate = w1.Range("AG" & 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, "AG")
            If P > -30 And P < 0 Then ListeCMU2 = ListeCMU2 & vbLf & "La CMU pour " & Cells(Lig, "C").Value & " expirera le " & Cells(Lig, "AG").Value
        End If

    Next Lig

    ' ********************************* Regularisation
If w1.Cells(Lig, "U") = Environ("username") Then

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

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

            Case Is <> ""
                ListeRegularisation3 = ListeRegularisation3 & vbLf & Cells(Lig, "U").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, "U").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, "U").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

End If

    ' ********************************* 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

    End If

Exit Sub

GestionErreur:
    MsgBox "Une erreur s'est produite. Fin de la procédure"
    Exit Sub

Application.ScreenUpdating = True 'Facultatif

End Sub

J'obtiens l'erreur 1004 sur la ligne If w1.cells(lig,"U") = Environ("username") Then

Le 08/02/2022 à 20:09

bonjour,

tu as mis avant ce qu'il fallait mettre après et inversément ...

ceci

If w1.Cells(Lig, "U") = Environ("username") Then

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

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

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

            Case "ATJM non renouvelable"
            ListeFinATJM3 = ListeFinATJM3 & vbLf & Cells(Lig, "U").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " se terminera définitivement le " & Cells(Lig, "AB").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, "U").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " est à faire pour débuter le " & Cells(Lig, "L").Value
            End If

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

    End Select

    Next Lig

End If

doit être ceci

    ' ********************************* ATJM à faire
    For Lig = 2 To w1.Range("L" & Rows.Count).End(xlUp).Row
If w1.Cells(Lig, "U") = Environ("username") Then
    Select Case w1.Cells(Lig, "AA").Value

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

            Case "ATJM non renouvelable"
            ListeFinATJM3 = ListeFinATJM3 & vbLf & Cells(Lig, "U").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " se terminera définitivement le " & Cells(Lig, "AB").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, "U").Value & " : L'ATJM pour " & Cells(Lig, "C").Value & " est à faire pour débuter le " & Cells(Lig, "L").Value
            End If

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

    End Select
End If
    Next Lig
Le 08/02/2022 à 21:18

Merci beaucoup, cela fonctionne bien

Rechercher des sujets similaires à "msgbox utilisateur"