Macro envoie mail visual basic

Option Explicit

Sub Conditions()
'Déclaration des variables
    'Lig est la variable pour boucler sur les lignes
    'DernLig représentera le n° de la dernière ligne remplie
    'Déclarées au type Long car :
    'ceux sont des variables de type numériques (n° de ligne) entiers
    'Comme Integer et Long occupent aujourd'hui autant d'espace mémoire
    'autant tout de suite prévoir pour des longs longs tableaux...
        'pour info : Integer = Nbre entier entre -32 768 et 32 767
        '            Long = Nbre entier entre -2 147 483 648 et 2 147 483 647
Dim Lig As Long, DernLigColA As Long, DernLigColB As Long
'Deux variables de type tableau (noter la présence des () qui nous l'indique)
'le premier TablStock pour les données de la colonne A qui sont des nombres entiers
Dim TablStock() As Long
'le second TablDates pour les données de la colonne B qui sont des dates
Dim TablDates() As Date

'------ RECUPERATION DES DONNEES -------
'Ici on va travailler dans la feuille Feuil1
With Sheets("Feuil1") ' A adapter le nom de la feuille
'Au préalable, il nous faut définir la taille des variables tableaux.
    'ces deux variables sont censées stocker x données
    'x étant le nombre de lignes occupées par ces données
    'on obtient x en faisant l'opération : Dernière Ligne - 1 (la première ligne comprenant des entêtes)
'--- Redimensionnement des variables tableaux ---
    '(calcul du nombre d'éléments composant chaque var tableau)
    '- de TablStock
    DernLigColA = .Range("A" & Rows.Count).End(xlUp).Row - 1
        'A noter dans un bloc With - End With la présence du point
        'devant les objets Range, Cell etc...
    ReDim TablStock(DernLigColA - 1) 'A noter - 1 car les tableaux commencent, par défaut, à l'indice 0
    '- de TablDates
    DernLigColB = .Range("B" & Rows.Count).End(xlUp).Row - 1
    ReDim TablDates(DernLigColB - 1)
'--- Remplissage des variables tableaux ---
    For Lig = 0 To UBound(TablStock)
        TablStock(Lig) = .Cells(Lig + 2, 1)
    Next
    For Lig = 0 To UBound(TablDates)
        TablDates(Lig) = .Cells(Lig + 2, 2)
    Next
'------ CONDITIONS - TESTS DES DONNEES RECUPEREES -----
'--- Condition 1
'se déclenche si l'une des cases des colonnes de stock est égale à un
'Comme une seule condition appliquée à la colonne A on va utiliser un If - Enf If
    'Boucle sur les données du TablStock
    For Lig = 0 To UBound(TablStock)
        'Si cette donnée est égale à 1 alors...
        If TablStock(Lig) = 1 Then
            'Ici on enverra un nimèle... Pour l'instant, message à l'utilisateur
            MsgBox "Valeur 1 trouvée en cellule A" & Lig + 2
        End If
    Next
'Comme plusieurs conditions appliquées à la colonne B on va utiliser un Select Case
    'Boucle sur les données du TablDates
    For Lig = 0 To UBound(TablDates)
        'premier test Si la date est "périmée" alors condition 4 sinon on teste
        'pour les conditions 2 et 3
        If TablDates(Lig) < CDate(Date) Then
            MsgBox "La date contenue en B" & Lig + 2 & " est périmée."
        Else
        'ici on va appeler le N° de semaine de la date stockée
        'cf la fonction num_sem en dessous de cette Sub...
            Select Case num_sem(TablDates(Lig))
'--- Condition 2
'se déclenche si l'une des cases de la colonne date de péremption
'contient une date se produisant la semaine prochaine
                Case num_sem(Date) + 1
                    MsgBox "La date contenue en B" & Lig + 2 & " se produit la semaine prochaine."
'--- Condition 3
'se déclenche si l'une des cates de la colonne date de péremption
'contient une date se produisant cette semaine
                Case num_sem(Date)
                    MsgBox "La date contenue en B" & Lig + 2 & " se produit cette semaine."
            End Select
        End If
    Next
End With
End Sub

Function num_sem(D As Date) As Long
'Auteur: Laurent Longre. X-Cell
'La fonction suivante renvoie le numéro de semaine conforme à la norme ISO,
'utilisée dans les pays européens (la première semaine d'un mois étant définie
'comme la première semaine comportant au moins quatre jours dans le mois).

D = Int(D)
num_sem = DateSerial(Year(D + (8 - Weekday(D)) Mod 7 - 3), 1, 1)
num_sem = ((D - num_sem - 3 + (Weekday(num_sem) + 1) Mod 7)) \ 7 + 1
End Function

                'Peu ajouter d'autre format si nécessaire, 
                'comme la bordure, la police etc.. 
                Select Case Mode 
                Case 0 
                    CouleurMFC = LoMFC.Interior.ColorIndex 
                Case 1 
                    CouleurMFC = LoMFC.Interior.Color 
                End Select 
                if Application.Caller.Interior.ColorIndex <> 2 'par exemple 
                    If CouleurMFC = CouleurSouhaitée then  
                          Envoyer mail 
'Eviter d'envoyer plusieurs mail 
                          Application.Caller.Interior.ColorIndex = 2   
                   end if 
               end if 

Option Explicit

Sub Conditions()
Dim Lig As Long, DernLigColF As Long, DernLigColB As Long
Dim TablStock() As Long
Dim TablDates() As Date
Dim Message As String

With Sheets("Feuil1")
    DernLigColF = .Range("F" & Rows.Count).End(xlUp).Row - 1
    ReDim TablStock(DernLigColF - 1)
    DernLigColB = .Range("B" & Rows.Count).End(xlUp).Row - 1
    ReDim TablDates(DernLigColB - 1)
    For Lig = 0 To UBound(TablStock)
        TablStock(Lig) = .Cells(Lig + 2, 6)
    Next
    For Lig = 0 To UBound(TablDates)
        TablDates(Lig) = .Cells(Lig + 2, 2)
    Next
    For Lig = 0 To UBound(TablStock)
        If TablStock(Lig) = 1 Then
            Message = Message & .Cells(Lig + 2, 1) & " Stock = 1!" & Chr(10)
        End If
    Next
    For Lig = 0 To UBound(TablDates)
        If TablDates(Lig) < CDate(Date) Then
            Message = Message & "La date contenue en B" & Lig + 2 & " est périmée." & Chr(10)
        Else
            Select Case num_sem(TablDates(Lig))
                Case num_sem(Date) + 1
                    Message = Message & "La date contenue en B" & Lig + 2 & " se produit la semaine prochaine." & Chr(10)
                Case num_sem(Date)
                    Message = Message & "La date contenue en B" & Lig + 2 & " se produit cette semaine." & Chr(10)
            End Select
        End If
    Next
End With
    If Message <> "" Then EnvoiMail Message
End Sub

Function num_sem(D As Date) As Long
D = Int(D)
num_sem = DateSerial(Year(D + (8 - Weekday(D)) Mod 7 - 3), 1, 1)
num_sem = ((D - num_sem - 3 + (Weekday(num_sem) + 1) Mod 7)) \ 7 + 1
End Function

Sub EnvoiMail(Message As String)
Dim Ol As New Outlook.Application
Dim OlMail As MailItem
Dim CurrFile As String

Set Ol = New Outlook.Application
Set OlMail = Ol.CreateItem(OlMailItem)
With OlMail
   .To = Sheets("Feuil1").Range("K3").Value
   .Subject = "Alerte date de péremtion"
   .Body = Message
   .Send
End With
End Sub

Private Sub Workbook_Open()
    ExectueMacro
End Sub

Sub ExectueMacro()
    'Par exemple toute les 10 heures
    Application.OnTime Now + TimeValue("10:00:00"), "ExectueMacro"
    Call Conditions()
End Sub