Discussion :

[stansoad0108]

Bonjour,

Dans le cadre d'un projet IT/RH, nous avons un fichier Excel avec des informations sur des dossiers d'employés (colonnes A -> G) et des dates de fin de période d'essai (colonne H) et dates délai prévenance fin de contrat (colonne I).
Débutant en VBA/Macro, nous souhaiterions créer une macro permettant :
1. D'identifier les lignes (dossiers) à l'ouverture du fichier (ou alternativement créer un bouton) arrivant à 7 jours avant la date de fin de période d'essai et 7 jours avant la date délai prévenance fin de contrat
2. Envoyer un email (Outlook - à une adresse email unique) en 2 parties (1 pour la partie date de fin de période d'essaie et 1 autre pour la partie date délai prévenance fin de contrat), correspondant à une extraction de l'ensemble des dossiers identifiés respectant les conditions ci-dessous avec l'ensemble des colonnes du fichier.

Merci par avance pour votre aide, et n'hésitez pas à nous dire si vous avez besoin d'autres informations.
Cordialement,

[mfoxy]

Bonjour,

Vous pourriez peut-être déposé une capture d'écran de votre tableau, anonymiser
Utilisez-vous un tableau structuré (vivement recommandé) , le nom de celui-ci, ou un 'simple' range.

Avez-vous un début de code, ou votre demande est la création complète d'un outils ?

Bav,

[stansoad0108]

Merci pour votre message. Vous trouverez en pj un extrait simplifié du fichier.
J'ai vu pas mal de codes sur d'autres sujets de discussion, mais non adaptés à mon projet.
On pourrait partir sur les 2 colonnes (H et I).

Merci pour votre aide.
Cdlt,

[Zeabon]

Bonjour à tous,

Pour faire ta demande, voilà comment je m'y prendrais :
(même si je suis sûr qu'il y a des meilleures solutions)

- Lancer la macro à l'ouverture : dans ThisWorkbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 Private Sub Workbook_Open()
End Sub

- Un filtre automatique sur la colonne H

- Copier les lignes non caché

- Coller les lignes dans un mail paramétré (destinataire, ...)

- Réitérer pour la colonne I

Tu trouveras ci-dessous 2 extraits de macro que j'ai faites qui devrait t'aider si tu décide de suivre la structure ci-dessus.

- Extrait 1 : Gestion de date pour insertion dans des filtres et copie des résultats affiché

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Debut = Format(DateSerial(Year(Me.TextBox1.Value), Month(Me.TextBox1.Value), Day(Me.TextBox1.Value)), "mm/dd/yy")
Fin = Format(DateSerial(Year(Me.TextBox2.Value), Month(Me.TextBox2.Value), Day(Me.TextBox2.Value)), "mm/dd/yy")
 
With Sheets("Production")
    If .FilterMode = True Then        'Test si des filtres sont présents et les supprime
        .ShowAllData
    End If
 
    .Range("A12:AB" & x).AutoFilter Field:=i, Criteria1:=">" & Debut, Criteria2:="<" & Fin, Operator:=xlAnd    'Mise en place des filtres
 
    .Range("A10:F" & x).SpecialCells(xlCellTypeVisible).Copy    ' Copie les lignes non caché par les filtres
End With

- Extrait 2 :Rédaction d'un mail et copie/colle un extrait de tableau (sous format image)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
Dim LeMail As Variant
Dim oMail As Outlook.MailItem
Dim outlookwordeditor
    Set LeMail = CreateObject("Outlook.Application")
    Set oMail = LeMail.CreateItem(olMailItem)
    Set wdDoc = oMail.GetInspector.WordEditor
    corps_Mail = "Bonjour, " & vbNewLine & vbNewLine & "Veuillez trouver ci-dessous le tableau des formations pour les prochaines sessions." & vbNewLine & "Merci de transmettre les convocations aux participants." & vbNewLine & vbNewLine
 
    With oMail
        .Subject = "Convocation formation session n°" & Numero
        .To = Destinataire    'Liste des adresse mails des destinataires
        .BodyFormat = olFormatHTML
        .Display '.send
 
        Set Rng = wdDoc.Content
 
        Sheets("Base P Unique").Range("B2:AC32").CopyPicture
        nb_lignes = Sheets("Base P Unique").Range("B2:AC32").Rows.Count
        For i = 1 To nb_lignes: Rng.InsertParagraphBefore: Next i
        Rng.Paste
 
        Rng.InsertBefore corps_Mail
        Rng.InsertAfter "" & vbNewLine & vbNewLine & "Cordialement," & vbNewLine & "Zeabon"
 
    End With

Zeabon

[MarcelG]

Bonjour à vous, Bonjour au Forum,

Personnellement, je préfère la méthode InlineShapes dans l'éditeur Word de l'item Outlook.

Voir la contribution ci-dessous.

[stansoad0108]

Bonjour,

Merci pour vos retours. Après plusieurs recherches et essais, voici ma proposition de code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 
Sub AlerteEtEnvoiMail()
 
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim w1 As Worksheet
Dim i As Long
Dim j As Long
Dim D As Date
Application.ScreenUpdating = False
Set w1 = Sheets("Feuil1") ' Feuille qui contient les alertes
D = Date
 
    On Error Resume Next
    Set OutlookApp = GetObject(, "outlook.application")
 
    Do While OutlookApp Is Nothing
        MsgBox "Veuillez ouvrir Outlook puis cliquer sur Ok"
        Set OutlookApp = GetObject(, "outlook.application")
    Loop
 
    On Error GoTo 0
 
    ' Boucle pour récupérer les dossiers avec date de fin de période d'essai entre 0 et 7 jours avant
    For i = 5 To w1.Range("H" & Rows.Count).End(xlUp).Row
        p_AlertePeriodeEssai = w1.Range("H" & i) - D
        If p_AlertePeriodeEssai <= 7 And p_AlertePeriodeEssai >= 0 Then
            mes_AlertePeriodeEssai = mes_AlertePeriodeEssai & "ALERTE : le dossier numéro" & " " & w1.Range("B" & i) & " " & "arrive à" & " " & p_AlertePeriodeEssai & " " & "jour(s) avant sa fin de période d'essai" & " " & "(" & w1.Range("H" & i) & ")" & Chr(10)
        End If
    Next
 
    ' Boucle pour récupérer les dossiers avec date délai de prévenance fin de contrat entre 0 et 7 jours avant
    For j = 5 To w1.Range("I" & Rows.Count).End(xlUp).Row 
        p_alerteFinContrat = w1.Range("I" & j) - D
        If p_alerteFinContrat <= 7 And p_alerteFinContrat >= 0 Then
            mes_alerteFinContrat = mes_alerteFinContrat & "ALERTE : le dossier numéro" & " " & w1.Range("B" & j) & " " & "arrive à" & " " & p_alerteFinContrat & " " & "jour(s) avant sa fin de contrat" & " " & "(" & w1.Range("I" & j) & ")" & Chr(10)
        End If
    Next
 
    Set OutlookMail = OutlookApp.CreateItem(0)
    With OutlookMail
        .Subject = "Alerte dossiers période d'essai & fin de contrat <= 7 jours"
        .To = "toto@toto.com"
        .Body = "Bonjour," & Chr(10) & Chr(10) & mes_AlertePeriodeEssai & Chr(10) & Chr(10) & mes_alerteFinContrat & Chr(10) & Chr(10) & "A traiter ASAP svp!" & Chr(10) & "Cordialement,"
        .Display
        '.Send
    End With
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
 
End Sub

Ca fonctionne :-)

Néanmoins, y'aurait-il d'autres choses/paramètres à ajouter pour gérer les erreurs et/ou améliorer le code ?

Enfin, je vais continuer à travailler sur des conditions pour dire que si les variables de messages (mes_AlertePeriodeEssai & mes_alerteFinContrat) sont vides, alors on écrit dans l'email qu'il n'y a pas d'alertes...Avez vous des suggestions?

Merci par avance.
Bonne journée.

Cordialement,