Macros à la suite pour envoi de mail

Version imprimable

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

Est-ce que cela vous conviendrait

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
Private Sub Workbook_Open()
Dim i As Long
Dim j As Long
Dim Sh As Worksheet
Dim Plage As Range
Dim adresse As String
 
Cells.EntireRow.Hidden = False
 
 Set Sh = ThisWorkbook.Worksheets("CDG")
    With Sh
        For i = 6 To .Range("A" & Rows.Count).End(xlUp).Row
            .Cells.EntireRow.Hidden = False
            For j = 10 To 13
                .Cells.EntireRow.Hidden = False
                  If CDate(.Cells(i, j)) = Format(Now, "dd/mm/yyyy") Then
                        No_Dossier = .Cells(i, 1).Value
                        No_Declaration = .Cells(i, 2).Value
                        Client = .Cells(i, 3).Value
                        Cells.EntireRow.Hidden = 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
                        .Item.To = Sh.Cells(i, 8).Value
                        .Item.Subject = " --RELANCE DOCUMENT-- "
                        .Item.send
                      End With
                  End If
            Next j
        Next i
 
    End With
 
Set Sh = Nothing
Cells.EntireRow.Hidden = False
 
End Sub

11/04/2015, 22h04
mad01

C'est super ! Ca fonctionne parfaitement. Un grand merci ! Une toute dernière question, comment peut-on faire des boucles pour qu'on puisse utiliser cette macro sur différents onglets du classeur ?

Ceci va faire la même macro sur toute les feuilles du classeur.
Voici la même macro avec les changements en rouge.

Si vous ne comprenez pas cette macro, faite le savoir, je la commenterai ligne par ligne.

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
Private Sub Workbook_Open()
Dim i As Long
Dim j As Long
Dim Sh As Worksheet
Dim Plage As Range

Dim Current As Worksheet

Cells.EntireRow.Hidden = False

For Each Current In Worksheets
    Set Sh = ThisWorkbook.Worksheets(Current.Name)
        With Sh
            For i = 6 To .Range("A" & Rows.Count).End(xlUp).Row
                .Cells.EntireRow.Hidden = False
                For j = 10 To 13
                    .Cells.EntireRow.Hidden = False
                      If CDate(.Cells(i, j)) = Format(Now, "dd/mm/yyyy") Then
                            No_Dossier = .Cells(i, 1).Value
                            No_Declaration = .Cells(i, 2).Value
                            Client = .Cells(i, 3).Value
                            Cells.EntireRow.Hidden = 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
                            .Item.To = Sh.Cells(i, 8).Value
                            .Item.Subject = " --RELANCE DOCUMENT-- "
                            .Item.send
                          End With
                      End If
                Next j
            Next i
            
        End With
Next
Set Sh = Nothing
Cells.EntireRow.Hidden = False

End Sub

Voici la macro avec les infos que vous m'avez donné, cependant il se passe rien..

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
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
 
Cells.EntireRow.Hidden = False
 
 
For Each Current In Worksheets
 Set Sh = ThisWorkbook.Worksheets("CDG")
    With Sh
        For i = 6 To .Range("A" & Rows.Count).End(xlUp).Row
            .Cells.EntireRow.Hidden = False
            For j = 10 To 12
                .Cells.EntireRow.Hidden = False
                  If CDate(.Cells(i, j)) = Format(Now, "dd/mm/yyyy") Then
                        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
                    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
                  End If
            Next j
        Next i
 
    End With
 Next
Set Sh = Nothing
Cells.EntireRow.Hidden = False
 
End Sub

J'ai compris l'erreur, cependant j'ai une erreur 1004 sur l'expression en rouge :

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
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

Cells.EntireRow.Hidden = False

For Each Current In Worksheets
 Set Sh = ThisWorkbook.Worksheets(Current.Name)
    With Sh
        For i = 6 To .Range("A" & Rows.Count).End(xlUp).Row
            .Cells.EntireRow.Hidden = False
            For j = 10 To 12
                .Cells.EntireRow.Hidden = False
                  If CDate(.Cells(i, j)) = Format(Now, "dd/mm/yyyy") Then
                        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
                    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
                  End If
            Next j
        Next i
 
    End With
 Next
Set Sh = Nothing
Cells.EntireRow.Hidden = False
 
End Sub

essayé comme cela,
je n'ai pas testé, là ou je suis je ne peut tester

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
Private Sub Workbook_Open()
Dim i As Long
Dim j As Long
Dim Sh As Worksheet
Dim Plage As Range
 
Dim Current As Worksheet
 
 
For Each Current In Worksheets
 
    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 13
                    .Cells.EntireRow.Hidden = False
                      If CDate(.Cells(i, j)) = Format(Now, "dd/mm/yyyy") Then
                            No_Dossier = .Cells(i, 1).Value
                            No_Declaration = .Cells(i, 2).Value
                            Client = .Cells(i, 3).Value
                            .Cells.EntireRow.Hidden = 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
                            .Item.To = Sh.Cells(i, 8).Value
                            .Item.Subject = " --RELANCE DOCUMENT-- "
                            .Item.send
                          End With
                      End If
                Next j
            Next i
           .Cells.EntireRow.Hidden = False
        End With
Next
Set Sh = Nothing
 
End Sub

J'ai toujours la même erreur d'exécution 1004 : Impossible de définir la propriété hidden de la classe range, sur la même ligne :

Code:

.Cells.EntireRow.Hidden = False

vers la fin du code

Voici mon code pour plus de clarté, je me suis trompé il y aurait une erreur sur l'argument en rouge :

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
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 = 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
                  If CDate(.Cells(i, j)) = Format(Now, "dd/mm/yyyy") Then
                        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
                    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
                  End If
            Next j
        Next i
        .Cells.EntireRow.Hidden = False
    End With
 Next
Set Sh = Nothing
 
End Sub

12/04/2015, 01h34
gnain

Je viens de l'essayé, et tout fonctionne comme sur des roulettes.
attaché votre vrai fichier et code que je l'essais

1 pièce(s) jointe(s)

Bonjour, voici le fichier : Pièce jointe 174504
et le 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
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 = 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
                  If CDate(.Cells(i, j)) = Format(Now, "dd/mm/yyyy") Then
                        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
                    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
                  End If
            Next j
        Next i
        .Cells.EntireRow.Hidden = False
    End With
 Next
Set Sh = Nothing
 
End Sub

Bonjour, je ne comprend pas, ici tout fonctionne, c'est peut-être la version d'Excel.
ici la seul manière d'avoir cette erreur c'est de protégé la feuille.
Est-ce que vous avez des cellules ou feuilles protégés?

si non essayé comme ça.

j'ai changé la ligne de code pour faire la même chose d'un autre manière.

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
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 = ThisWorkbook.Worksheets(Current.Name)
    With Sh
        .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row).EntireRow.Hidden = False
        For i = 6 To .Range("A" & Rows.Count).End(xlUp).Row
            .Cells.EntireRow.Hidden = False
            For j = 10 To 12
                .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row).EntireRow.Hidden = False
                  If CDate(.Cells(i, j)) = Format(Now, "dd/mm/yyyy") Then
                        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
                        .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row).EntireRow.Hidden = 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
                  End If
            Next j
        Next i
        .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row).EntireRow.Hidden = False
    End With
 Next
Set Sh = Nothing
 
End Sub

12/04/2015, 14h21
mad01

Bonjour, oui effectivement j'ai des feuilles protegées.. Je vais essayer

J'ai maintenant une erreur d’exécution 13 sur la ligne :

Code:

If CDate(.Cells(i, j)) = Format(Now, "dd/mm/yyyy") Then

Pourtant le format est bon..
12/04/2015, 14h35
gnain

Si il y a des feuilles protégés, si tu veux, il y a moyen de déprotégé les feuilles au début du code puis la reprotégé à la fin.

pour l'erreur,
quel est la valeur de la cellule en question. ici tout fonctionne, Est-ce que tu as des date dans toute tes cellules?
12/04/2015, 14h38
mad01

J'utilise Excel 2013, ca serait la raison de cette erreur ?
Non pour l'instant les cases sont vides, mais les colonnes concernés sont bien au format date
12/04/2015, 14h41
gnain

si les autre sont vide essaie comme ça

Code:

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

toujours la même erreur, est-il possible de m'envoyer le fichier pour que je puisse voir ?
12/04/2015, 14h49
gnain

1 pièce(s) jointe(s)

Voilà!
12/04/2015, 14h51
mad01

J'obtiens la même erreur, il y aurait donc un souci au niveau de mon excel ?
12/04/2015, 14h52
gnain

Pour être certain remplace
ce code

Code:

If CDate(.Cells(i, j)) = Format(Now, "dd/mm/yyyy") And CDate(.Cells(i, j)) <> "" Then

par

Code:

If CDate(.Cells(i, j)) = Format(Now, "dd/mm/yyyy") Then

dans le fichier attaché
12/04/2015, 15h01
mad01

il y a maintenant une erreur sur WithMailenvelope
Par contre j'ai réussi à avoir un mail uniquement pour la 1ère ligne du 1er onglet mais il y a un tableau vierge qui s'affiche en dessous..
Je peux avoir le fichier avec une adresse mail bidon, pour que je puisse l'exécuter tel quel ?
12/04/2015, 15h05
gnain

Citation:

Envoyé par mad01

C'est super ! Ca fonctionne parfaitement. Un grand merci ! Une toute dernière question, comment peut-on faire des boucles pour qu'on puisse utiliser cette macro sur différents onglets du classeur ?

mais que c'est-il donc passé depuis cette réponse ...
12/04/2015, 15h07
mad01

C'est depuis que je souhaite appliquer cette macro dans chacun des onglets, alors que sur un seul onglet ca fonctionnait parfaitement

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