Message box selon 2 critères

Résolu/Fermé
Signaler
Messages postés
1
Date d'inscription
vendredi 19 février 2016
Statut
Membre
Dernière intervention
19 février 2016
-
 Bipbipdu19 -
Bonjour,

Je suis actuellement sur un fichier de suivi des actions en cours au sein de mon entreprise et je cherche à faire apparaitre à l'ouverture du fichier des messages box selon la date d'échéance.

Je n'arrive pas à faire fonctionner la macro comme je le souhaite lorsque le délais est dépassé.

Je souhaite que le message box de délais dépassé apparaisse lorsque la date dans la colonne K est antérieure à la date du jour et lorsque dans la colonne L il n'y a pas marqué Clôturé. Actuellement il m'indique toute les dates antérieures à aujourd'hui même les actions clôturés.

Pouvez-vous m'aider? Je ne sais pas comment faire, je débute sur les macro.

D'avance merci.

Cordialement.

PS : désolé je n'arrive pas à joindre mon fichier, donc voici ma macro :

Option Explicit

Sub Verification()
Dim Nblg As Long
Dim Msg1 As String, Msg2 As String, Msg3 As String
Dim Cel As Range

  Application.ScreenUpdating = True
  With Sheets("Tableau")
    Nblg = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("K6:K" & Nblg).AutoFilter field:=1, Criteria1:=">=" & CSng(Date) + 7, Operator:=xlAnd, Criteria2:="<=" & CSng(Date) + 30
    If Application.Subtotal(103, .Columns("K")) > 1 Then
      For Each Cel In .Range("K7:K" & Nblg).SpecialCells(xlCellTypeVisible)
        Msg1 = Msg1 & vbCr & "Faire dans le mois l'action " & Cel.Offset(0, -10)
      Next Cel
    End If
    .Range("K6:K" & Nblg).AutoFilter field:=1, Criteria1:="<" & CSng(Date) + 7, Operator:=xlAnd, Criteria2:=">=" & CSng(Date)
    If Application.Subtotal(103, .Columns("K")) > 1 Then
      For Each Cel In .Range("K7:K" & Nblg).SpecialCells(xlCellTypeVisible)
        Msg2 = Msg2 & vbCr & "Faire dans la semaine l'action " & Cel.Offset(0, -10)
      Next Cel
    End If
    .Range("K6:K" & Nblg).AutoFilter field:=1, Criteria1:="<" & CSng(Date), Operator:=xlAnd, Criteria2:=">=" & 1
    If Application.Subtotal(103, .Columns("K")) > 1 Then
      For Each Cel In .Range("K7:K" & Nblg).SpecialCells(xlCellTypeVisible)
        Msg3 = Msg3 & vbCr & "Délai dépassé action " & Cel.Offset(0, -10)
      Next Cel
    End If
    .Range("K6:K" & Nblg).AutoFilter
  End With
  If Len(Msg1) > 0 Then
    MsgBox Msg1, vbInformation, "Tableau de suivi"
  End If
  If Len(Msg2) > 0 Then
    MsgBox Msg2, vbExclamation, "Tableau de suivi"
  End If
    If Len(Msg3) > 0 Then
    MsgBox Msg3, vbCritical, "Tableau de suivi"
  End If
End Sub

3 réponses

Messages postés
16135
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
8 décembre 2021
1 566
Bonjour,


PS : désolé je n'arrive pas à joindre mon fichier, donc voici ma macro :


Pour transmettre un fichier,
il faut passer par un site de pièce jointe tel que cjoint.com

Allez sur ce site : https://www.cjoint.com/
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...
Bonjour,

Merci à toi f894009, voici donc l'adresse du lien de mon fichier :

http://www.cjoint.com/c/FBwhEdZNPK8

Dans l'attente de votre aide à tous.

Cordialement.
Messages postés
16135
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
8 décembre 2021
1 566
Bonjour,

fichier modifie: https://www.cjoint.com/c/FBwiARhwf0f
Bonjour,

Merci beaucoup à toi cela va beaucoup me servir.
Merci pour ta réactivité également.

Cordialement.