VBA Excel alerte

Bonjour,

je dois réaliser un tableau d'environs 700 lignes et suivre les péremptions à 3 mois afin d'organiser une rotation.

j'aimerai un code vba qui va déclencher une alerte en envoyant à deux personnes la listes des produits dont la péremption est à 3 mois.

Tableau en PJ

Merci par avance pour votre aide

Mango19

Désolée du retard

Voici comment Lister tous les produits qui expirent dans 3 mois dans une msgbox.

Il faut tout de même noter que les MsgBox ont un nombre limité de caractères

ce qui veut dire que si tu as 700 lignes et que 40 produits se périment au même moment tu est dans l'embarras

Solution :

Utilise un Userform et tu y mets un grand Label pour récupérer toutes les alerte.

Copies ce code et colles-le dans le module 1 et essaie, si cela te convient dit-le nous.

Sub Alerte()
'Alerte sur les dates d'expiration des dossiers des Véhicules
'************
'By Nathalie Charette 2019

'1- Déclaration de mes variables
'********************************************************************
Dim j As Integer
    Dim CELL As Range, Mes As String, DerLig As Long
'********************************************************************
'2- Début de ma procédure
    With ThisWorkbook.Worksheets("Med PB") ' Le classeur où sont les données de dates d'expiration
       DerLig = .Range("C4").End(xlDown).Row
       For Each CELL In .Range("C4:C" & DerLig).Cells
          If DateDiff("m", Date, CDate(CELL.Value)) = 3 Then
                 Mes = Mes & Chr(149) & " " & CELL.Offset(, -2).Value & Space(1) & CELL.Offset(, -1).Value & _
                 " Expire dans " & DateDiff("m", Date, CDate(CELL.Value)) & " mois" & Chr(13) & vbCr
          End If
       Next CELL
    MsgBox "ALERTE PEREMPTION AU " & Format(Now, "dd/mm/yyyy") & Chr(10) & Chr(10) & Chr(10) _
    & Chr(13) & Mes & vbCrLf & vbclrf, vbCritical, "Alert"
    End With
End Sub

Bonjour toutes et tous

merci @ Nathalie

juste pour le fun en s'appuyant du code de Nathalie ci-dessus on combine avec l'usf1

avec textbox1 en multiline +label1 et un bouton fermer

ci-joint

merci à Nathalie

crdlt,

André

z6060

Nathalie et Andre13 bonjour,

un très très grand merci à tous les deux, l'alerte fonctionne à merveille.

Mais j'aimerai que cette alerte envoie un mail de façon automatique à deux personnes (boite mail outlook) je sais pas si c'est réalisable

Merci encore pour votre aide précieuse

Amicalement

Mango19

Bonjour,

Une autre piste que tu peux appeler (procédure Test) avec un bouton sur la feuille issu des outils "Formulaire" puis clic droit et "Affecter une macro..." :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim DateLimite As Date
    Dim Texte As String

    With Worksheets("MED PB")

        Set Plage = .Range(.Cells(4, 3), .Cells(.Rows.Count, 3).End(xlUp))
        DateLimite = .Cells(1, 3).Value

    End With

    'boucle et construit le texte pour les produits périmés
    For Each Cel In Plage

        If Int(DateLimite + 90 - Cel.Value) >= 0 Then Texte = Texte & "-" & Cel.Offset(, -1).Value & vbCrLf

    Next Cel

    'si le texte est vide, pas de produit périmés, fin de procédure
    If Texte = "" Then Exit Sub

    Texte = Left(Texte, Len(Texte) - 2)

    EnvoiMail Texte

End Sub

Sub EnvoiMail(Texte As String)

    Dim AppOutlook As Object
    Dim OutMail As Object

    Set AppOutlook = CreateObject("Outlook.Application")
    Set OutMail = AppOutlook.CreateItem(0)

    With OutMail

        'adresses des deux personnes à adapter !
        .To = "adressepersonne_1@orange.fr" & ";" & "adressepersonne_2@orange.fr"

        .Subject = "Médicaments périmés. Société MANGO ;-)"

        'construit le message
        .Body = "Bonjour," & _
                Chr(13) & Chr(13) & _
                "Les produits ci-dessous sont périmés :" & _
                Chr(13) & _
                Texte & _
                Chr(13) & Chr(13) & _
                "Très cordialement." & _
                Chr(13) & Chr(13) & _
                "MANGO19"

        'affiche le message
        .Display

        '.Send '<--- enlever l'apostrophe pour que le mail soit envoyé automatiquement !

    End With

    Set OutMail = Nothing
    Set AppOutlook = Nothing

End Sub

Bonjour Theze,

je vous remercie pour votre réponse.

j'ai donc essayé mais comme je suis novice je dois pas faire la bonne manipulation.

je mets le tableau avec la formule copiée si vous pouvez regarder pourquoi cela ne fonctionne pas

Merci encore pour votre aide

Amicalement

Mango19

Re,

Coucou et merci à Thèze

@Mango19

juste à mettre le code de Thèze et d'effectuer les modifications en lisant les commentaires du code

1/ renomme ta Feuill1 de ton classeur en MED PB

2/ modifies :

'adresses des deux personnes à adapter !

.To = "adressepersonne_1@orange.fr" & ";" & "adressepersonne_2@orange.fr"

3/ effectue la lecture des commentaires du code de Thèze

crdlt,

André

Nathalie, Theze et Andre13 bonsoir,

un très grand merci tout fonctionne très bien.

Dernière question je souhaite faire apparaître toutes les informations concernant le produit arrivant à péremption, pourriez vous s'il vous plait m'indiquer à quel niveau je dois modifier.

Alerte actuel : NUROFEN

Alerte souhaitée : IBUPROFENE NUROFEN 20/01/2020

Bien cordialement

Mango19

Bonjour,

Andre13 , merci d'avoir expliqué la mise en oeuvre à Mango19, c'est vrai que j'ai été assez avare en explications

Mango19, dans la boucle For Each... tu remplaces cette ligne de code :

If Int(DateLimite + 90 - Cel.Value) >= 0 Then Texte = Texte & "-" & Cel.Offset(, -1).Value & vbCrLf

par celle-ci :

If Int(DateLimite + 90 - Cel.Value) >= 0 Then Texte = Texte & "-" & Cel.Offset(, -2).Value & " " & Cel.Offset(, -1).Value & " " & Cel.Value & vbCrLf

Les gars, vous m'avez devancés

N'oublie pas d'activer Microsoft Outlook directory ... pour qu'Outlook fonctionne parfaitement

Bravo ! MANGO, si ton problème est résolu, alors n'oublie pas de ....

Rechercher des sujets similaires à "vba alerte"