Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

D

darkjedi

XLDnaute Nouveau
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

VB: 
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
 

Pièces jointes

  • Test Voiture.xlsm
    62.3 KB · Affichages: 4
Trier par date Trier par votes

wDog66

XLDnaute Occasionnel
Bonsoir Darkjedi,

Je n'ai peut-être pas tout compris
Mais remplacez tout votre code par celui-ci
Code: 
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+
 
Vote positif 0 Vote négatif
D

darkjedi

XLDnaute Nouveau
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.
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

M
  • Résolu(e)
XL 2021 PUBLIPOSTAGE : Mise en forme du corps de message issu d'une cellule excel (VBA)
Réponses
4
Affichages
331
Minus&Cortex
M
E
  • Question
XL 2010 problème macro qui désactive le pavé numérique
2
Réponses
18
Affichages
1 K
Dranreb
  • Question
XL 2013 Réduire un code
Réponses
0
Affichages
470
chaelie2015
M
  • Question
XL 2010 Aide à la suppression d'un produit en double dans un magasin spécifique avec conditions
Réponses
9
Affichages
689
Mody200
M
N
  • Question
Microsoft 365 Recherche dans un tableau structuré à partir d'une TextBox
Réponses
11
Affichages
271
NONO14
N
  • Question
Autres la fonction similaire
Réponses
11
Affichages
362
patricktoulon
U
  • Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
303
Phil69970
A
  • Résolu(e)
XL 2021 Céer un fichier (.text) avec VBA pour enregistrer les évènements dans un journal
Réponses
4
Affichages
414
arnoldbrice19
A
A
  • Résolu(e)
Microsoft 365 With Selection.Parent.MailEnvelope.Item
Réponses
13
Affichages
925
patricktoulon
M
  • Question
XL 2010 Demande de quantité d'un produit dans un magasin spécifique selon la date la plus ancienne
2
Réponses
21
Affichages
1 K
Mody200
M
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…