alerte mail en fonction d'une cellule

**Thierry60440** · 06/12/2019, 09h29

Bonjour,

Encore merci de vous donner la peine, j'ai essayer de comprendre ce qui n'allait pas, mais certaines choses me dépassent encore.
La réception du mail ne ce fait pas toujours bien j'ai un code d'erreur 1004 "la méthode select de la classe range à échoué, mon tableau est filtré et je n'ai plus une seule ligne, sauf si une date de contrôle technique, et uniquement celle ci, est dépassée, cette ligne est sélectionnée mais rien ne part.
Lorsque les mails partent, j'ai systématiquement une image blanche, que ce soit dans le corps du message ou en pièce jointe.

Cdt

**TonyNiort79** · 06/12/2019, 14h38

Bonjour,

ci-dessous programme modifié

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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
Sub test()
'Private Sub Workbook_Open()
 
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim Signature As String
    Dim NomSujet As String
Dim DateControleTechnique As Date
Dim DateControlePollution As Date
DateControleTechnique = Date - 700
DateControlePollution = Date - 350
 
'Contrôle Technique
Dim NbreDateCT As Integer
Dim ControleTechnique As String
ControleTechnique = "Contrôle Technique Sup à 700 jours"
Dim image As String
image = ThisWorkbook.Path & Application.PathSeparator & ControleTechnique & ".JPG"
 
' filtre colonne "J" Contrôle Technique >= à 700 jours
Feuil8.ListObjects("TableauGeneral").Range.AutoFilter 'enlèvement filtre existant
Feuil8.ListObjects("TableauGeneral").Range.AutoFilter Field:=10, Criteria1:="<=" & Format(DateControleTechnique, "mm/dd/yyyy")
'Vérification quantités supérieurs à 1 (1 qui représente la ligne du titre)
NbreDateCT = WorksheetFunction.Subtotal(3, Sheets("Tableau général").Columns("J:J"))
If NbreDateCT > 1 Then
    'Création tableau en JPG pour insértion dans le mail
    Dim PlageCT As Range
    Set PlageCT = Feuil8.ListObjects("TableauGeneral").Range
    Application.CutCopyMode = False
    PlageCT.CopyPicture
    PlageCT.Select
      With Feuil8.ChartObjects.Add(0, 0, _
                    Selection.Width, Selection.Height).Chart
                    .Paste
                    .Export ThisWorkbook.Path & Application.PathSeparator & ControleTechnique & ".JPG", "JPG"
      End With
 
'Suppression image crée
Feuil8.ChartObjects.Delete
 
'Creation mail
    NomSujet = ControleTechnique
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
strbody = "<p>" & ControleTechnique & "<br>"
 
Signature = "<B><p>Nom Prenom</B><p>" & _
            "Titre<br>" & _
            "<B>Société</B><br> " & _
            "Adresse<br>" & _
            "Téléphone<br>" & _
            "Mail<br>"
 
 'langage HTML
 '<p>   <p> sauter une ligne
 '<br>  <br>a la ligne
 '<B>   </B> en gras
 
 
    On Error Resume Next
    With OutMail
        .To = "adresse.mail"
        .CC = ""
        .BCC = ""
        .Subject = NomSujet
        .HTMLBody = strbody & "<p>" & "<img src='" & image & "'></img></html>" & "<p>" & Signature
        'demande un accuse de reception
        '.OriginatorDeliveryReportRequested = True
        'demande un accuse de lecture
        '.ReadReceiptRequested = True
       ' .HTMLBody = Signature
        .attachments.Add image 'pour ajouter l'image en pièce jointe
        .Send
        '.Display
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 
End If
 
'Enlèvement filtres automatiques
Feuil8.ListObjects("TableauGeneral").Range.AutoFilter
 
'Contrôle Pollution
Dim NbreDateCP As Integer
Dim ControlePollution As String
ControlePollution = "Contrôle Pollution Sup à 350 jours"
Dim imageP As String
imageP = ThisWorkbook.Path & Application.PathSeparator & ControlePollution & ".JPG"
 
' filtre colonne K Contrôle Pollution >= à 350 jours
Feuil8.ListObjects("TableauGeneral").Range.AutoFilter Field:=11, Criteria1:="<=" & Format(DateControlePollution, "mm/dd/yyyy")
 
'Vérification quantités supérieurs à 1 (1 qui représente la ligne du titre)
NbreDateCP = WorksheetFunction.Subtotal(3, Sheets("Tableau général").Columns("K:K"))
If NbreDateCP > 1 Then
 
    'Création tableau en JPG pour insértion dans le mail
    Dim PlageCP As Range
    Set PlageCP = Feuil8.ListObjects("TableauGeneral").Range
    Application.CutCopyMode = False
    PlageCP.CopyPicture
    PlageCP.Select
      With Feuil8.ChartObjects.Add(0, 0, _
                    Selection.Width, Selection.Height).Chart
                    .Paste
                    .Export ThisWorkbook.Path & Application.PathSeparator & ControlePollution & ".JPG", "JPG"
      End With
 
    'Suppression image crée
    Feuil8.ChartObjects.Delete
 
 
'Creation mail
    NomSujet = ControlePollution
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
strbody = "<p>" & ControlePollution & "<br>"
 
Signature = "<B><p>Nom Prenom</B><p>" & _
            "Titre<br>" & _
            "<B>Société</B><br> " & _
            "Adresse<br>" & _
            "Téléphone<br>" & _
            "Mail<br>"
 
 'langage HTML
 '<p>   <p> sauter une ligne
 '<br>  <br> aller à la ligne
 '<B>   </B> mettre en gras
 
 
    On Error Resume Next
    With OutMail
        .To = "adresse.mail"
        .CC = ""
        .BCC = ""
        .Subject = NomSujet
        .HTMLBody = strbody & "<p>" & "<img src='" & imageP & "'></img></html>" & "<p>" & Signature
        'demande un accuse de reception
        '.OriginatorDeliveryReportRequested = True
        'demande un accuse de lecture
        '.ReadReceiptRequested = True
       ' .HTMLBody = Signature
        .attachments.Add imageP 'pour ajouter l'imageP en pièce jointe
        .Send
        '.Display
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 
End If
 
 'Enlèvement filtres automatiques
 Feuil8.ListObjects("TableauGeneral").Range.AutoFilter
 Range("A1").Select
 
End Sub

**Thierry60440** · 11/12/2019, 15h36

Bonjour,

j'ai toujours une image blanche.

De plus je me suis aperçu qu'il faut que j'ouvre mon classeur sur la feuille "Tableau général" pour ne pas avoir l'erreur "range" alors qu'une macro fait déjà ouvrir mon classeur sur une feuille "Accueil".
Est il possible qu' à l'ouverture il ouvre la feuille "Tableau général" pour l'analyser et une fois fait, il revienne sur l’Accueil ?
Encore merci du temps que vous me consacrer.

**TonyNiort79** · 12/12/2019, 06h56

Bonjour,
le fichier dont je faisais les essais s'ouvrait dans le bon onglet

ajouter en début de programme la ligne n'importe où avant la ligne n°20

Code :

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

Sheets("Tableau général").Activate

et à la fin de la procédure (macro) (ligne n° 164)

Code :

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

Sheets("Accueil").Activate

**Thierry60440** · 13/01/2020, 08h35

Bonjour,
Bonne année.
Des raisons personnelles ont fait que je n'ai pas pu venir sur le forum plus tôt, mais je reviens vers vous car j'ai toujours le problème de l'image blanche sur fond noir.
Cdt

**TonyNiort79** · 13/01/2020, 19h05

Bonjour à tous et mes meilleurs vœux pour cette année 2020,
il faudrait mettre le code sur les balises pour voir

**Thierry60440** · 14/01/2020, 08h19

Bonjour.
voici le code ainsi qu'une capture de mon tableau.

CDT

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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
Private Sub Workbook_Open()
 
Sheets("Tableau").Activate
 
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim Signature As String
    Dim NomSujet As String
Dim DateControleTechnique As Date
Dim DateControlePollution As Date
DateControleTechnique = Date - 700
DateControlePollution = Date - 350
 
'Contrôle Technique
Dim NbreDateCT As Integer
Dim ControleTechnique As String
ControleTechnique = "Contrôle Technique Sup à 700 jours"
Dim image As String
image = ThisWorkbook.Path & Application.PathSeparator & ControleTechnique & ".jpg"
 
' filtre colonne "J" Contrôle Technique >= à 700 jours
Feuil8.ListObjects("TableauGeneral").Range.AutoFilter 'enlèvement filtre existant
Feuil8.ListObjects("TableauGeneral").Range.AutoFilter Field:=10, Criteria1:="<=" & Format(DateControleTechnique, "mm/dd/yyyy")
'Vérification quantités supérieurs à 1 (1 qui représente la ligne du titre)
NbreDateCT = WorksheetFunction.Subtotal(3, Sheets("Tableau").Columns("J:J"))
If NbreDateCT > 1 Then
    'Création tableau en jpg pour insértion dans le mail
    Dim PlageCT As Range
    Set PlageCT = Feuil8.ListObjects("TableauGeneral").Range
    Application.CutCopyMode = False
    PlageCT.CopyPicture
    PlageCT.Select
      With Feuil8.ChartObjects.Add(0, 0, _
                    Selection.Width, Selection.Height).Chart
                    .Paste
                    .Export ThisWorkbook.Path & Application.PathSeparator & ControleTechnique & ".jpg", "jpg"
      End With
 
'Suppression image crée
Feuil8.ChartObjects.Delete
 
'Creation mail
    NomSujet = ControleTechnique
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
strbody = "<p>" & ControleTechnique & "<br>"
 
Signature = "<B><p></B><p>" & _
            "<br>" & _
            "<B></B><br> " & _
            "<br>" & _
            "<br>" & _
            "<br>" & _
            "<br>"
 
 'langage HTML
 '<p>   <p> sauter une ligne
 '<br>  <br>a la ligne
 '<B>   </B> en gras
 
 
    On Error Resume Next
    With OutMail
        .To = ".....@......fr"
        .CC = ""
        .BCC = ""
        .Subject = NomSujet
        .HTMLBody = strbody & "<p>" & "<img src='" & image & "'></img></html>" & "<p>" & Signature
        'demande un accuse de reception
        '.OriginatorDeliveryReportRequested = True
        'demande un accuse de lecture
        '.ReadReceiptRequested = True
       ' .HTMLBody = Signature
        .attachments.Add image 'pour ajouter l'image en pièce jointe
        .Send
        '.Display
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 
End If
 
'Enlèvement filtres automatiques
Feuil8.ListObjects("TableauGeneral").Range.AutoFilter
 
'Contrôle Pollution
Dim NbreDateCP As Integer
Dim ControlePollution As String
ControlePollution = "Contrôle Pollution Sup à 350 jours"
Dim imageP As String
imageP = ThisWorkbook.Path & Application.PathSeparator & ControlePollution & ".jpg"
 
' filtre colonne K Contrôle Pollution >= à 350 jours
Feuil8.ListObjects("TableauGeneral").Range.AutoFilter Field:=11, Criteria1:="<=" & Format(DateControlePollution, "mm/dd/yyyy")
 
'Vérification quantités supérieurs à 1 (1 qui représente la ligne du titre)
NbreDateCP = WorksheetFunction.Subtotal(3, Sheets("Tableau").Columns("K:K"))
If NbreDateCP > 1 Then
 
    'Création tableau en jpg pour insértion dans le mail
    Dim PlageCP As Range
    Set PlageCP = Feuil8.ListObjects("TableauGeneral").Range
    Application.CutCopyMode = False
    PlageCP.CopyPicture
    PlageCP.Select
      With Feuil8.ChartObjects.Add(0, 0, _
                    Selection.Width, Selection.Height).Chart
                    .Paste
                    .Export ThisWorkbook.Path & Application.PathSeparator & ControlePollution & ".jpg", "jpg"
      End With
 
    'Suppression image crée
    Feuil8.ChartObjects.Delete
 
 
'Creation mail
    NomSujet = ControlePollution
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
strbody = "<p>" & ControlePollution & "<br>"
 
Signature = "<B><p></B><p>" & _
            "<br>" & _
            "<B></B><br> " & _
            "<br>" & _
            "<br>" & _
            "<br>" & _
            "<br>"
 
 'langage HTML
 '<p>   <p> sauter une ligne
 '<br>  <br> aller à la ligne
 '<B>   </B> mettre en gras
 
 
    On Error Resume Next
    With OutMail
        .To = ".....@......fr"
        .CC = ""
        .BCC = ""
        .Subject = NomSujet
        .HTMLBody = strbody & "<p>" & "<img src='" & imageP & "'></img></html>" & "<p>" & Signature
        'demande un accuse de reception
        '.OriginatorDeliveryReportRequested = True
        'demande un accuse de lecture
        '.ReadReceiptRequested = True
       ' .HTMLBody = Signature
        .attachments.Add imageP 'pour ajouter l'imageP en pièce jointe
        .Send
        '.Display
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 
End If
 
 'Enlèvement filtres automatiques
 Feuil8.ListObjects("TableauGeneral").Range.AutoFilter
 Range("A1").Select
 
 Sheets("Accueil").Activate
 
End Sub

**TonyNiort79** · 14/01/2020, 19h35

Bonjour à tous,
je ne vois rien de bizarre,
serait-il possible de joindre une copie du fichier avec les données confidentielles effacée pour mieux voir ?

je ferais des tests avec ce fichier et je verrai bien
merci beaucoup

**Thierry60440** · 15/01/2020, 09h56

Bonjour,
voici le fichier modifié.
Merci de vous donner la peine.

Cdt

**TonyNiort79** · 22/01/2020, 13h12

Bonjour à tous,

Je viens de faire des tests, pas chez moi car je n'ai pas de compte Outlook,
et seulement maintenant car je n'ai pas beaucoup de temps devant moi,

et comme avant cela fonctionne très bien,
je ne comprends pas l'image blanche,

j'ai fait une capture des images qui sont envoyées et l'image est bien dans le mail, et en copie jointe

Nom : Capture.JPG
Affichages : 167
Taille : 69,2 Ko