Macros à la suite pour envoi de mail

Version imprimable

Voir 40 message(s) de cette discussion en une page

essaie en ajoutant ceci en rouge

Code:

1
2
3
For Each Current In Worksheets
    Set Sh = Nothing
    Set Sh = ThisWorkbook.Worksheets(Current.Name)

12/04/2015, 15h32
mad01

Je vais essayer, que veux dire cette expression ?
12/04/2015, 15h37
gnain

on vide l'objet avant d'en créer un autre
12/04/2015, 15h48
mad01

Toujours une erreur d’exécution sur IfCdate..
12/04/2015, 15h55
gnain

essaie avec

Code:

If CDate(.Cells(i, j)) = Format(Now, "dd/mm/yyyy") And .Cells(i, j) <> "" Then
12/04/2015, 16h03
mad01

Dois-je enlever la protection sur les feuilles avant de faire cela ?

Oublie le dernier code
on va essayé de gérer l'erreur

copie tout ce code
oui il faut d'abor enlever la protection
si ce code fonctionne on enlèvera ensuite la protection par code

Code:

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
Private Sub Workbook_Open()
Dim i As Long
Dim j As Long
Dim Sh As Worksheet
Dim Plage As Range
Dim Adresse As String
 
Dim Current As Worksheet
 
 
For Each Current In Worksheets
    Set Sh = Nothing
    Set Sh = ThisWorkbook.Worksheets(Current.Name)
    With Sh
        .Cells.EntireRow.Hidden = False
        For i = 6 To .Range("A" & Rows.Count).End(xlUp).Row
            .Cells.EntireRow.Hidden = False
            For j = 10 To 12
                .Cells.EntireRow.Hidden = False
                On Error Resume Next
                  If CDate(.Cells(i, j)) = Format(Now, "dd/mm/yyyy") Then
                        If Err.Number Then
                            Err.Clear
                            On Error GoTo 0
                            GoTo suivant
                        End If
                        On Error GoTo 0
                        No_Dossier = .Cells(i, 1).Value
                        No_Declaration = .Cells(i, 2).Value
                        Client = .Cells(i, 3).Value
                        No_Document = .Cells(i, 4).Value
                        Date_expiration = .Cells(i, 7).Value
                        .Cells.EntireRow.Hidden = True
                        ActiveWorkbook.EnvelopeVisible = True
 
                        With .Parent.MailEnvelope
                            .Introduction = "Bonjour, merci de relancer le client pour le dossier suivant : " & vbCrLf & _
                            "N° de dossier: " & No_Dossier & vbCrLf & _
                            "N° de déclaration: " & No_Declaration & vbCrLf & _
                            "Client: " & Client & vbCrLf & _
                            "N°document: " & No_Document & vbCrLf & _
                            "Date expiration: " & Date_expiration
                            .Item.To = Sh.Cells(i, 9).Value
                            .Item.Subject = " --RELANCE DOCUMENT A REGULARISER SOUS D48-- "
                            .Item.Send
                        End With
suivant:
 
                  End If
            Next j
        Next i
        .Cells.EntireRow.Hidden = False
    End With
 Next
Set Sh = Nothing
End Sub

12/04/2015, 16h14
mad01

l'erreur d'exécution 13 persiste toujours sur Ifcdate..
12/04/2015, 16h18
gnain

Tu es certain d'avoir fait un copier coller de ce code ?
Je n'ai jamais vue ce que tu dit avec un On Error Resume Next juste avant la ligne d'erreur
12/04/2015, 16h20
mad01

Peut être un bug j'ai relancé le fichier et il y a en fait une autre erreur sur WithParentMailenvelope :erreur d'exécution 438 Propriété ou Méthode non gérée par cet objet
12/04/2015, 16h29
gnain

oups!
C'est un test que j'avais fait.
enlève le parent.

donc le problème de date est réglé?
12/04/2015, 16h32
mad01

Erreur d'exécution 440 : ne prend pas en charge cet objet, et la ligne à erreur est la suivante maintenant :

Code:

.Item.To = Sh.Cells(i, 9).Value
12/04/2015, 16h44
gnain

1 pièce(s) jointe(s)

C'est probablement parce qu'il n'y a pas d'adresse
essaie avec ce fichier attaché.
12/04/2015, 17h00
mad01

Ca fonctionne, un génie..
Par contre il y a le message : Cette feuille de calcul contient des lignes ou des colonnes masquées que le destinataire pour rendre visible ? Souhaitez vous continuer ?
Peux on pas supprimer ca ?

Ensuite comment peux on utiliser cette macro dans une feuille protégée (désolé d'être embêtant..) ?
12/04/2015, 17h08
gnain

pour enlever le message
il faut mettre au tout début du code

Code:

Application.DisplayAlerts = false

et mettre à la toute fin

Code:

Application.DisplayAlerts = True

Est-ce que la protection est pas mot de passe?
12/04/2015, 17h09
mad01

oui avec un mot de passe

copier ce code et mettre le mot de passe dans le code
à la ligne 17 et 56

Code:

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
Private Sub Workbook_Open()
 
Dim i As Long
Dim j As Long
Dim Sh As Worksheet
Dim Plage As Range
 
Dim Current As Worksheet
Application.DisplayAlerts = False
 
 
For Each Current In Worksheets
    Set Sh = Nothing
    Set Sh = ThisWorkbook.Worksheets(Current.Name)
    With Sh
        Sheets(Current.Name).Select
        .Unprotect ("votre mot de passe")
        .Cells.EntireRow.Hidden = False
        For i = 6 To .Range("A" & Rows.Count).End(xlUp).Row
            .Cells.EntireRow.Hidden = False
            For j = 10 To 12
                .Cells.EntireRow.Hidden = False
                On Error Resume Next
                  If CDate(.Cells(i, j)) = Format(Now, "dd/mm/yyyy") Then
                        If Err.Number Then
                            Err.Clear
                            On Error GoTo 0
                            GoTo suivant
                        End If
                        On Error GoTo 0
                        No_Dossier = .Cells(i, 1).Value
                        No_Declaration = .Cells(i, 2).Value
                        Client = .Cells(i, 3).Value
                        No_Document = .Cells(i, 4).Value
                        Date_expiration = .Cells(i, 7).Value
                        .Cells.EntireRow.Hidden = True
                        ActiveWorkbook.EnvelopeVisible = True
 
                        With .MailEnvelope
                            .Introduction = "Bonjour, merci de relancer le client pour le dossier suivant : " & vbCrLf & _
                            "N° de dossier: " & No_Dossier & vbCrLf & _
                            "N° de déclaration: " & No_Declaration & vbCrLf & _
                            "Client: " & Client & vbCrLf & _
                            "N°document: " & No_Document & vbCrLf & _
                            "Date expiration: " & Date_expiration
                            .Item.To = Sh.Cells(i, 9).Value
                            .Item.Subject = " --RELANCE DOCUMENT A REGULARISER SOUS D48-- "
                            .Item.Send
                        End With
suivant:
 
                  End If
            Next j
        Next i
        .Cells.EntireRow.Hidden = False
        .Protect Password:="Votre mot de passe", DrawingObjects:=True
    End With
 Next
Set Sh = Nothing
Sheets("CDG").Select
Application.DisplayAlerts = True
End Sub

12/04/2015, 17h53
mad01

Merci je vais essayer. UN GRAND GRAND MERCI pour tout le temps passé sur mon cas, et de m'avoir appris pas mal de choses !:D
12/04/2015, 18h08
gnain

si tout est ok, il frauderait passer en Résolu:resolu:

Voir 40 message(s) de cette discussion en une page