XL 2019 Message diffèrent en fonction état booléens

[darkjedi]

Bonjour à tous,

J'ai un fichier Excel exemple qui me permet d'afficher un message à l'ouverture du fichier en fonction de l'état des booléens.
Voici ce que j'ai réussi à programmer pour l'instant
Etape 1) Vérification des différentes dates contenues sur chaque feuille et inscrire dans 1 cellule déterminée la plus petite date pour chaque feuille
Etape 2) Vérification si chaque plus petite date de chaque feuille est inférieure à 30 jours de la date du jour pour changer l'état d'un booléen affecté à la feuille
Etape 3) Création du message en fonction de l'état de chaque booléen (code à modifier = module Verif_Date)

Je voudrais modifier l'étape 3 car pour 3 ou 5 booléens ce n'est pas très grave mais si je passe à plusieurs dizaines de booléens cela devient impossible à gérer.

Et la seconde question serait pour chaque feuille de remplacer les formules à mettre en place par du code VBA pour afficher "OK / ATTENTION / DANGER " en fonction du délai de la date du jour + 30 jours. Pour la mise en forme des cellules concernées je verrais cela ultérieurement. Dans le fichier je n'ai fait qu'en cellule A7 des feuilles.

J'espère que cela est possible à faire

Je mets le code ainsi que le fichier en exemple afin que vous puissiez m'apporter votre éclairage. Je peux modifier mon code pour qu'il soit plus rapide et compréhensible.

Par avance je vous remercie pour votre aide

Option Explicit

'declaration feuille
Dim Sh As Worksheet

'declaration date
Dim DateMinV1 As Date
Dim DateMinV2 As Date
Dim DateMinV3 As Date
Dim DateMinV4 As Date
Dim DateDuJour As Date

'declaration nom de la feuille
Public NomFeuille As String

'declaration des erreurs
Dim V1 As Boolean
Dim V2 As Boolean
Dim V3 As Boolean
Dim V4 As Boolean

'declaration message
Dim MessageV1 As String
Dim MessageV2 As String
Dim MessageV3 As String
Dim MessageV4 As String


Sub Verification_Date()
    
    'definition de la variable date du jour et du nombre d'erreurs et des booleens
    DateDuJour = Date
    V1 = False
    V2 = False
    V3 = False
    V4 = False
    
    'boucle pour determiner la date la plus petite de la feuille activée
    For Each Sh In Worksheets
        If Sh.name = "V1" Then
            Sh.Range("H1") = Application.WorksheetFunction.Min(Sh.Range("A3:E19"))
            DateMinV1 = Sh.Range("H1")
        End If
    
        If Sh.name = "V2" Then
            Sh.Range("H1") = Application.WorksheetFunction.Min(Sh.Range("A3:E19"))
            DateMinV2 = Sh.Range("H1")
        End If
        
        If Sh.name = "V3" Then
            Sh.Range("H1") = Application.WorksheetFunction.Min(Sh.Range("A3:E19"))
            DateMinV3 = Sh.Range("H1")
        End If
        
        If Sh.name = "V4" Then
            Sh.Range("H1") = Application.WorksheetFunction.Min(Sh.Range("A3:E19"))
            DateMinV4 = Sh.Range("H1")
        End If
    Next Sh
    
    'determination etat bag en true ou false
    If DateMinV1 < DateDuJour + 30 Then
        V1 = True
        MessageV1 = ("vehicule 1")
    End If
    
    If DateMinV2 < DateDuJour + 30 Then
        V2 = True
        MessageV2 = ("vehicule 2")
    End If
        
    If DateMinV3 < DateDuJour + 30 Then
        V3 = True
        MessageV3 = ("vehicule 3")
    End If
        
    If DateMinV4 < DateDuJour + 30 Then
        V4 = True
        MessageV4 = ("vehicule 4")
    End If
    
 '*******************************************************************************************************************************
 'EMISSION MESSAGE SELON ETAT
 '*******************************************************************************************************************************
 '*******************************************************************************
 '*******************************************************************************
 [COLOR=rgb(184, 49, 47)]'Je voudrai modifier ce code afin que le traitement du message soit plus rapide
 'le nombre de vehicule peut augmenter fortement
 'et ce code n'est pas viable pour plusieurs dizaine de voitures[/COLOR]
 '*******************************************************************************
 '*******************************************************************************
 
 

 ' 1 V en  true
    'Affichage d'un message avec userform en fonction du nombre d'erreurs pendant 3 secondes
    If V1 = True And V2 = False And V3 = False And V4 = False Then
        NomFeuille = ("V1")
        Mess_Chang_Gant.TextBox2 = NomFeuille
        Mess_Chang_Gant.Show 0
        Application.Wait (Now + TimeValue("00:00:03"))
        Mess_Chang_Gant.Hide
        Call EnvoiDuMail(NomFeuille)
    End If
    
    If V1 = False And V2 = True And V3 = False And V4 = False Then
        NomFeuille = ("V2")
        Mess_Chang_Gant.TextBox2 = NomFeuille
        Mess_Chang_Gant.Show 0
        Application.Wait (Now + TimeValue("00:00:03"))
        Mess_Chang_Gant.Hide
        Call EnvoiDuMail(NomFeuille)
    End If
    
    If V1 = False And V2 = False And V3 = True And V4 = False Then
        NomFeuille = ("V3")
        Mess_Chang_Gant.TextBox2 = NomFeuille
        Mess_Chang_Gant.Show 0
        Application.Wait (Now + TimeValue("00:00:03"))
        Mess_Chang_Gant.Hide
        Call EnvoiDuMail(NomFeuille)
    End If
    
    If V1 = False And V2 = False And V3 = False And V4 = True Then
        NomFeuille = ("V4")
        Mess_Chang_Gant.TextBox2 = NomFeuille
        Mess_Chang_Gant.Show 0
        Application.Wait (Now + TimeValue("00:00:03"))
        Mess_Chang_Gant.Hide
        Call EnvoiDuMail(NomFeuille)
    End If
    
 '*******************************************************************************************************************************
 ' 2 V en  true
    'Affichage d'un message avec userform en fonction du nombre d'erreurs pendant 3 secondes
    If V1 = True And V2 = True And V3 = False And V4 = False Then
        NomFeuille = ("V1 + V2")
        Mess_Chang_Gant.TextBox2 = NomFeuille
        Mess_Chang_Gant.Show 0
        Application.Wait (Now + TimeValue("00:00:03"))
        Mess_Chang_Gant.Hide
        Call EnvoiDuMail(NomFeuille)
    End If
    
    If V1 = True And V2 = False And V3 = True And V4 = False Then
        NomFeuille = ("V1 + V3")
        Mess_Chang_Gant.TextBox2 = NomFeuille
        Mess_Chang_Gant.Show 0
        Application.Wait (Now + TimeValue("00:00:03"))
        Mess_Chang_Gant.Hide
        Call EnvoiDuMail(NomFeuille)
    End If
    
    If V1 = True And V2 = False And V3 = False And V4 = True Then
        NomFeuille = ("V1 + V4")
        Mess_Chang_Gant.TextBox2 = NomFeuille
        Mess_Chang_Gant.Show 0
        Application.Wait (Now + TimeValue("00:00:03"))
        Mess_Chang_Gant.Hide
        Call EnvoiDuMail(NomFeuille)
    End If
    
    If V1 = False And V2 = True And V3 = True And V4 = False Then
        NomFeuille = ("V2 + V3")
        Mess_Chang_Gant.TextBox2 = NomFeuille
        Mess_Chang_Gant.Show 0
        Application.Wait (Now + TimeValue("00:00:03"))
        Mess_Chang_Gant.Hide
        Call EnvoiDuMail(NomFeuille)
    End If
    
    If V1 = False And V2 = True And V3 = False And V4 = True Then
        NomFeuille = ("V2 + V4")
        Mess_Chang_Gant.TextBox2 = NomFeuille
        Mess_Chang_Gant.Show 0
        Application.Wait (Now + TimeValue("00:00:03"))
        Mess_Chang_Gant.Hide
        Call EnvoiDuMail(NomFeuille)
    End If
    
    
    If V1 = False And V2 = False And V3 = True And V4 = True Then
        NomFeuille = ("V3 + V4")
        Mess_Chang_Gant.TextBox2 = NomFeuille
        Mess_Chang_Gant.Show 0
        Application.Wait (Now + TimeValue("00:00:03"))
        Mess_Chang_Gant.Hide
        Call EnvoiDuMail(NomFeuille)
    End If
'********************************************************************************************************************************
' 3 V en  true
    'Affichage d'un message avec userform en fonction du nombre d'erreurs pendant 3 secondes
    If V1 = True And V2 = True And V3 = True And V4 = False Then
        NomFeuille = ("V1 + V2 +V3")
        Mess_Chang_Gant.TextBox2 = NomFeuille
        Mess_Chang_Gant.Show 0
        Application.Wait (Now + TimeValue("00:00:03"))
        Mess_Chang_Gant.Hide
        Call EnvoiDuMail(NomFeuille)
    End If
    
    If V1 = True And V2 = True And V3 = False And V4 = True Then
        NomFeuille = ("V1 + V2 + V4")
        Mess_Chang_Gant.TextBox2 = NomFeuille
        Mess_Chang_Gant.Show 0
        Application.Wait (Now + TimeValue("00:00:03"))
        Mess_Chang_Gant.Hide
        Call EnvoiDuMail(NomFeuille)
    End If
    
    If V1 = False And V2 = True And V3 = True And V4 = True Then
        NomFeuille = ("V2 + V3 + V4")
        Mess_Chang_Gant.TextBox2 = NomFeuille
        Mess_Chang_Gant.Show 0
        Application.Wait (Now + TimeValue("00:00:03"))
        Mess_Chang_Gant.Hide
        Call EnvoiDuMail(NomFeuille)
    End If

    
'********************************************************************************************************************************
' 4 V en  true
    'Affichage d'un message avec userform en fonction du nombre d'erreurs pendant 3 secondes
    If V1 = True And V2 = True And V3 = True And V4 = True Then
        NomFeuille = ("V1 +V2 + V3 + V4")
        Mess_Chang_Gant.TextBox2 = NomFeuille
        Mess_Chang_Gant.Show 0
        Application.Wait (Now + TimeValue("00:00:03"))
        Mess_Chang_Gant.Hide
        Call EnvoiDuMail(NomFeuille)
    End If
End Sub

 

[wDog66]

Bonsoir Darkjedi,

Je n'ai peut-être pas tout compris
Mais remplacez tout votre code par celui-ci

Option Explicit

'declaration feuille
Dim Sh As Worksheet

Sub Verification_Date()
  Dim Msg As String
  'boucle pour determiner la date la plus petite de la feuille activée
    For Each Sh In Worksheets
      If Sh.Name <> "Contact" Then
        Sh.Range("H1") = Application.WorksheetFunction.Min(Sh.Range("A3:E19"))
        If Sh.Range("H1").Value < Date + 30 Then
          Msg = Msg & Sh.Name & " + "
        End If
      End If
    Next Sh
    Msg = Left(Msg, Len(Msg) - Len(" + "))
    Mess_Chang_Gant.TextBox2 = Msg
    Mess_Chang_Gant.Show 0
    Application.Wait (Now + TimeValue("00:00:03"))
    Mess_Chang_Gant.Hide
    Call EnvoiDuMail(Msg)
End Sub

Pour la seconde question, je n'ai pas compris ce que vous souhaitez, c'est bien les formules

A+

 

[darkjedi]

Bonjour wDog66;

Merci pour votre réponse.
Je vais essayer votre code.
Est ce que la boucle va s'effectuer à l'ouverture du fichier et le message va se compléter en fonction de la plus petite date ?
D'après ce que je lis c'est le cas. Je fais l'essai et je vous fais mon retour.

Pour la seconde question, j'aimerai remplacer les formules mise en place dans les cellules (ici seulement en A7 de chaque feuille concernée) par du code VBA pour afficher "OK / ATTENTION / DANGER " en fonction du délai de la date du jour + 30 jours dans la cellule. Pour la mise en forme des cellules concernées je verrais cela ultérieurement.

Merci en tout cas pour cette première aide qui simplifie mon code.

 

[darkjedi]

Bonjour wDog66;
J'ai essayé votre code sur le véritable fichier . Cela fonctionne au top.
Le code est plus rapide, plus précis et plus clair.
Merci beaucoup pour cette superbe amélioration.