classeur EXCEL en panne

**caius5bioz** · 28/06/2022, 08h50

Bonjour

Je suis nouveau sur le forum et je viens solliciter votre aide

il y a environ 2 ans j'ai fait modifier un classeur de suivi de validité de laisser passer pour ma société afin de faire ajouter une macro qui enverrait un mail de rappel à l'adresse de mon choix afin de prendre en compte la liste des accès à renouveler.
La personne en charge de se dossier a quitté la société et fait probablement quelques modifications involontaires car l'alerte mail ne fonctionne plus.
La personne qui m'avait aidé à l'époque n'est plus joignable et je ne sais pas vérifier la macro.
Est-ce que quelqu'un saurait m'aider s'il vous plait?

**halaster08** · 28/06/2022, 08h57

Bonjour,

Beaucoup d'intervenants n'ouvrent pas les fichiers avec macro (cf message épinglé)
Tu auras plus de réponses en copiant directement le code de la macro ainsi que des captures d'écran

**caius5bioz** · 28/06/2022, 09h35

voici la macro

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
Public Sub EnvoiAlerte()
 
 
Dim ws_Suivi As Worksheet
    Set ws_Suivi = Suivi
 
 
Dim Verif As String
    Verif = ws_Suivi.Range("AM2")
 
If Verif = "Non" Then
 
Dim NbLigne As Integer
    NbLigne = ws_Suivi.Range("F1")
 
Dim Destinataire As String
Dim Subject As String
Dim EnTete As String
Dim Body As String
Dim Pied As String
 
 
    Destinataire = ws_Suivi.Range("O1")
    Subject = ws_Suivi.Range("T1")
    EnTete = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 3.2//EN"">" & _
            "<HTML><HEAD>" & _
            "<META HTTP-EQUIV=""Content-Type"" CONTENT=""text/html; charset=iso-8859-1"">" & _
            "<META NAME=""Generator"" CONTENT=""MS Exchange Server version 14.02.5004.000"">" & _
            "<BODY><DIV STYLE=""font-face: Calibri;"">"
    Body = ""
    Pied = "</DIV></BODY></HTML>"
 
For i = 27 To 37
 
Body = Body & "<B>" & ws_Suivi.Cells(3, i).Value & "</B>" & "<br>"
 
    For j = 6 To 6 + NbLigne
 
    If ws_Suivi.Cells(j, i) <> "" Then
        Body = Body & ws_Suivi.Cells(j, i) & "<br>"
    End If
 
    Next j
 
Body = Body & "<br>"
 
Next i
 
Dim AppOutlook As Object
Dim MailOutlook As Object
 
Dim test As String
 
Set AppOutlook = CreateObject("Outlook.Application")
Set MailOutlook = AppOutlook.CreateItem(olMailItem)
 
With MailOutlook
    .Subject = Subject '<-- objet
    .Recipients.Add Destinataire '<-- destinataire de l'email
    '.GetInspector.CommandBars.Item("Insert").Controls("Signature").Controls(1).Execute
    .HTMLBody = EnTete & Body & Pied & MailOutlook.HTMLBody '<-- Corps du message
    .Display
    .Send
 
End With
 
Set MailOutlook = Nothing
Set AppOutlook = Nothing
 
 
ws_Suivi.Range("Z1") = Format(Date, "mm/dd/yyyy")
 
End If
 
End Sub

et voici une copie d'écran du fichier

Nom : Capture d’écran 2022-06-28 093315.jpg
Affichages : 209
Taille : 389,1 Ko

**halaster08** · 28/06/2022, 09h52

Merci d'utiliser les balises codes, ça rend le code beaucoup plus lisible

Je n'ai pas eu d'erreur a l'exécution de ce code, sauf si l'adresse mail était vide, ce qui n'est pas le cas sur ta copie d'écran
Peux-tu préciser quelle erreur tu as, et sur quelle ligne.

Ci-dessous ton code légèrement modifié, j'ai ajouté qq .value, ça ne devrait pas corriger le problème mais tu peux tester quand même

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
 
Public Sub EnvoiAlerte()
 
 
Dim ws_Suivi As Worksheet
Set ws_Suivi = Suivi
 
 
Dim Verif As String
Verif = ws_Suivi.Range("AM2").Value
 
If Verif = "Non" Then
 
Dim NbLigne As Integer
NbLigne = ws_Suivi.Range("F1").Value
 
Dim Destinataire As String
Dim Subject As String
Dim EnTete As String
Dim Body As String
Dim Pied As String
 
 
Destinataire = ws_Suivi.Range("O1").Value
Subject = ws_Suivi.Range("T1").Value
EnTete = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 3.2//EN"">" & _
"<HTML><HEAD>" & _
"<META HTTP-EQUIV=""Content-Type"" CONTENT=""text/html; charset=iso-8859-1"">" & _
"<META NAME=""Generator"" CONTENT=""MS Exchange Server version 14.02.5004.000"">" & _
"<BODY><DIV STYLE=""font-face: Calibri;"">"
Body = ""
Pied = "</DIV></BODY></HTML>"
 
For i = 27 To 37
 
Body = Body & "<B>" & ws_Suivi.Cells(3, i).Value & "</B>" & "<br>"
 
For j = 6 To 6 + NbLigne
 
If ws_Suivi.Cells(j, i).Value <> "" Then
Body = Body & ws_Suivi.Cells(j, i).Value & "<br>"
End If
 
Next j
 
Body = Body & "<br>"
 
Next i
 
Dim AppOutlook As Object
Dim MailOutlook As Object
 
Dim test As String
 
Set AppOutlook = CreateObject("Outlook.Application")
Set MailOutlook = AppOutlook.CreateItem(olMailItem)
 
With MailOutlook
.Subject = Subject '<-- objet
.Recipients.Add Destinataire '<-- destinataire de l'email
'.GetInspector.CommandBars.Item("Insert").Controls("Signature").Controls(1).Execute
.HTMLBody = EnTete & Body & Pied & MailOutlook.HTMLBody '<-- Corps du message
.Display
.Send
 
End With
 
Set MailOutlook = Nothing
Set AppOutlook = Nothing
 
 
ws_Suivi.Range("Z1") = Format(Date, "mm/dd/yyyy")
 
End If
 
End Sub

**caius5bioz** · 28/06/2022, 10h50

bonjour et merci pour la tentative

Erreur d'exécution'424'
Objet requis

Code :

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

1
2
3
4
5
Public Sub EnvoiAlerte()
 
 
Dim ws_Suivi As Worksheet
Set ws_Suivi = Feuil1

**halaster08** · 28/06/2022, 11h17

Oups, j'avais oublié que j'avais changé le codename de la feuille, la tienne s'appelle Suivi normalement, j'ai modifié le code du post précédent

**Qwazerty** · 28/06/2022, 11h18

Salut

A remplacer par

Code :

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

Set ws_Suivi = Suivi

++
Qwaz

classeur EXCEL en panne

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager