Bonjour,
je me permets de vous contacter car j'ai un petit soucis.
Vous pourrez voir sur mon fichier Excel un bouton DCO/Test qui vérifie l'état d'avancement de ces derniers et envoie un mail si l'utilisateur souhaite relancer les candidats.

Probleme : quand je ne sélectionne qu'une seule ligne si un filtre est actif, les affichages outlook s'ouvrent en boucle pour le candidat sélectionné jusqu'à planter. Or, j'ai bel et bien besoin de filtrer mes données pour faire ce que je souhaite faire..
Comment pourrais-je éviter ce pb?

PROD 2023 - RH_CO_DO_usf (1).xlsm

Merci d'avance si vous avez des idées ! bonne soirée

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
 
Public Sub Envoi_Mail_DCO(typeMail As String, etatInitial As String)
 
    ' On définit tout nos objets
    Dim OutApp As Object, OutMail As Object, Signature As String
    Dim cell As Range, rng As Range, rngSelection As Range
    Dim candidatsSheet As Worksheet, mailSheet As Worksheet
    Dim eMail As String
    Dim PRENOM As String
    Dim NOM As String
    Dim etatDCO As String, etatTest As String
    Dim corpsTexte As String, formuleBonjour As String
    Dim sujet As String
    Dim ETAT As String
    Dim colPrenom As Integer
    Dim colNom As Integer
    Dim colMail As Integer
    Dim colDCO As Integer
    Dim colTest As Integer
    Dim colRelanceDCO As Integer
    Dim colRelanceTest As Integer
 
    Dim NombreEmails As Integer
    NombreEmails = 0
 
    Set OutApp = CreateObject("Outlook.Application")
    Set candidatsSheet = Worksheets("CANDIDATS") ' Feuille des candidats
    Set mailSheet = Worksheets("MAIL") ' Feuille des mails
    Set rngSelection = Selection 'Sélection
 
    'Trouver les colonnes
    colPrenom = Cherche_ColonneXL(candidatsSheet, "PRENOM")
    colNom = Cherche_ColonneXL(candidatsSheet, "NOM")
    colMail = Cherche_ColonneXL(candidatsSheet, "MAIL")
    colDCO = Cherche_ColonneXL(candidatsSheet, "DCO")
    colTest = Cherche_ColonneXL(candidatsSheet, "TEST Technique")
    colRelanceDCO = Cherche_ColonneXL(candidatsSheet, "RELANCE DCO")
    colRelanceTest = Cherche_ColonneXL(candidatsSheet, "RELANCE TEST")
 
    ' On empêche la sélection de plusieurs lignes
    If Selection.Columns.count > 1 Then
        MsgBox "Merci de ne sélectionner qu'une seule colonne. Vous pouvez uniquement sélectionner plusieurs lignes.", vbExclamation, "Erreur"
        Exit Sub
    Else
 
        ' On récupère la signature enregistrée dans Outlook
        Set OutMail = OutApp.CreateItem(0)
        Signature = OutMail.HTMLBody
        OutMail.Close False ' Ferme le mail utilisé pour récupérer la signature sans l'envoyer
 
        On Error Resume Next
        Set rng = rngSelection.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
 
        If rng Is Nothing Then
            MsgBox "Il n'y a pas de cellules visibles dans la sélection."
            Exit Sub
        End If
 
        For Each cell In rng
            eMail = candidatsSheet.Cells(cell.Row, colMail).Value
            PRENOM = candidatsSheet.Cells(cell.Row, colPrenom).Value
            NOM = candidatsSheet.Cells(cell.Row, colNom).Value
            etatDCO = candidatsSheet.Cells(cell.Row, colDCO).Value
            etatTest = candidatsSheet.Cells(cell.Row, colTest).Value
 
            If eMail <> "" And Not cell.EntireRow.Hidden Then
 
                If etatDCO = "Pas envoyé" And typeMail = "DCO" And etatInitial = "Pas envoyé" Then
                    ETAT = "DCO - Pas envoyé"
                ElseIf etatDCO = "Envoyé / Pas réalisé" And typeMail = "DCO" And etatInitial = "Envoyé / Pas réalisé" Then
                    ETAT = "DCO - Envoyé / Pas réalisé"
                ElseIf etatTest = "Pas envoyé" And typeMail = "TEST" And etatInitial = "Pas envoyé" Then
                    ETAT = "TEST - Pas envoyé"
                ElseIf etatTest = "Envoyé / Pas réalisé" And typeMail = "TEST" And etatInitial = "Envoyé / Pas réalisé" Then
                    ETAT = "TEST - Envoyé / Pas réalisé"
                Else
                    GoTo NextIteration
                End If
 
                NombreEmails = NombreEmails + 1
 
 
                corpsTexte = mailSheet.Cells(Application.Match(ETAT, mailSheet.Range("A:A"), 0), 2).Value
                sujet = mailSheet.Cells(Application.Match(ETAT, mailSheet.Range("A:A"), 0), 3).Value
 
                formuleBonjour = "Bonjour " & PRENOM & " " & NOM & ",<br><br>"
 
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = eMail
                    .Subject = sujet
                    .Display ' Affiche l'aperçu avant d'envoyer encore une fois
                    .HTMLBody = formuleBonjour & corpsTexte & "<br>" & .HTMLBody
                End With
                Set OutMail = Nothing
 
            End If
NextIteration:
      Next cell
 
      If NombreEmails = 0 Then ' Si aucun e-mail n'a été envoyé
          MsgBox "Aucun e-mail ne correspond à votre relance. Veuillez vérifier les conditions de votre sélection."
      End If
 
    End If
    Set OutApp = Nothing
 
End Sub