Range de cellules dans mail

Version imprimable

Bonjour,
Mon code permettant d'envoyer des emails marche bien. Cependant je cherche à ajouter une plage de cellules aux emails en fonction de la personne à qui j'envoie. (exemple si dans la colonne F il y a monsieur X, envoyer la plage B32 à F34 etc ...)

En Colonne B il y a l'adresse email du destinataire
C, un oui ou un non pour savoir si on doit lui envoyer le mail
D un send si le message a été envoyé
F le prénom et nom de la personne.

Mon problème se rapproche de celui la : http://www.excelguru.ca/forums/showt...e-into-outlook , mais je n'arrive pas à l'adapter à mon code.

Voici mon 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
Sub benmail()
 Dim OutApp As Object
    Dim OutMail As Object
    Dim Cell As Range
 
Sheets("email").Activate
 
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
 
    On Error GoTo cleanup
    For Each Cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If Cell.Value Like "?*@?*.?*" And _
           LCase(Cells(Cell.Row, "C").Value) = "yes" _
           And LCase(Cells(Cell.Row, "D").Value) <> "send" Then
 
            Set OutMail = OutApp.CreateItem(0)
 
            On Error Resume Next
            With OutMail
                .To = Cell.Value
                .CC = "les adresses mail"
                .Subject = "le sujet"
                .Body = "message "
 
 
                .Display
 
            End With
            On Error GoTo 0
            Cells(Cell.Row, "D").Value = "send"
            Set OutMail = Nothing
        End If
    Next Cell
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
 
End Sub

Merci pour votre aide :)

Bonjour,

Je te propose en premier lieu la construction du message avec les valeurs de la zone à envoyer au destinataire.
Tu peux éventuellement enregistrer-sous.. la classeur au format "htm" et ensuite joindre le fichier ainsi créé avec "Attachments.Add" après avoir masqué les lignes et colonnes que le destinataire ne doit pas voir (je vais creuser cette piste ;o) ) :

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
 
Sub EnvoiMail()
 
    Dim Outlook As Object
    Dim Message As Object
    Dim Destinataire As String
    Dim Tbl()
    Dim I As Long
    Dim J As Long
    Dim Valeurs As String
    Dim Corps As String
 
 
    Set Outlook = CreateObject("Outlook.Application")
    Set Message = Outlook.CreateItem(0)
 
    'zone à joindre
    Tbl = Range("A1:F10")
 
    For I = 1 To UBound(Tbl, 1)
 
        For J = 1 To UBound(Tbl, 2)
 
            'les valeurs sont séparées par des "<>", à adapter selon envie
            Valeurs = Valeurs & Tbl(I, J) & "<>"
 
        Next J
 
        'supprime les "<>" de fin de ligne
        Valeurs = Left(Valeurs, Len(Valeurs) - 2)
 
        'passe à la ligne suivante
        Valeurs = Valeurs & vbCrLf
 
    Next I
 
    'destinataire
    Destinataire = "destinataire@orange.fr"
 
    'construction du message avec les valeurs
    Corps = "Bonjour," & vbCrLf & vbCrLf
    Corps = Corps & "Veuillez trouver ci-dessous les valeurs comme convenu :" & vbCrLf & vbCrLf
    Corps = Corps & Valeurs & vbCrLf & vbCrLf
    Corps = Corps & "Cordialement." & vbCrLf & vbCrLf
    Corps = Corps & "balibou."
 
    With Message
 
        .To = Destinataire
        .Subject = "Envoi de valeurs"
        .Body = Corps
        .Display
        .Send
 
    End With
 
End Sub

Hervé.

01/03/2013, 17h14
balibou

Merci pour ton retour, je vais essayer avec ton code et creuser aussi de mon côté ... :)

Pour l'instant je fais display chaque message et je copie colle les tableaux que je veux sur le corps du message ... Pas très pratique !

PS : mon but c'est de faire en sorte qu'il n'y ai pas de pièce jointe :) si c'est possible ...

MailEnveloppe

Bonjour,

Le problème pour envoyer une feuille Excel dans le corps d'un mail, c'est que tu perds la mise en page. Il existe cependant la propriété MailEnvelope d'un objet Worksheet qui permet d'insérer une feuille dans le corps d'un mail.
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 Sub TestEnvoiFeuilleCommeMail() Dim olSession As New Outlook.Application Dim wbClasseur As Workbook Dim wsFeuille As Worksheet Dim rgPlage As Range Dim objObjet As Object Set wbClasseur = ActiveWorkbook Set wsFeuille = wbClasseur.ActiveSheet wsFeuille.MailEnvelope.Introduction = "Confirmez vous ces données ?" Set oObjet = wsFeuille.MailEnvelope.Item With oObjet .To = "toto.titi@truc.com" .Subject = "Test" .Send End With Set olSession = Nothing Set wbClasseur = Nothing Set wsFeuille = Nothing Set oObjet = Nothing End Sub
Le seul problème avec cette façon de faire, c'est que tu restes dans Excel (tu répliques Fichier/Envoyer vers), que tu ne peux pas utiliser la méthode Display, uniquement Send (pas de contrôle donc, à bien tester avant) et que cela déclenche un message de sécurité d'Outlook, même avec un projet signé.

Mais en bidouillant, tu devrais arriver à tes fins. La solution de Theze marche bien, mais effectivement tu as une pj.

Golonne.

Bonjour,

Comme dit dans mon précédent post, j'ai creusé un peu et pondu le code ci-dessous. Il faut bien sûr adapter car je me sais pas comment est organisée ta feuille. Le code parcourt la colonne F (colonne des noms des destinataires) et en fonction cache les colonnes et lignes qui ne le concernent pas puis exporte la feuille en "pdf", n'est alors visible sur ce dernier, que la zone visible définie dans la feuille. Pour plus de souplesse, je pense qu'il faudrait une colonne qui contienne les zones correspondantes à chaque destinataire, il suffirait alors dans le code de calculer chaque partie à cacher. Dis moi ce que tu en pense et on va le faire évoluer. Pour tester, avance en pas à pas (touche F8) afin de voir comment se déroule la chose. Il te faut créer ou définir un dossier pour stocker tes pdf, ici c'est "D:\Feuille en PDF\", à adapter :

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
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
 
Sub EnvoiMail()
 
    Dim Fe As Worksheet
    Dim Outlook As Object
    Dim Message As Object
    Dim Plage As Range
    Dim Cel As Range
    Dim DerLigne As Long
    Dim DerColonne As String
    Dim Corps As String
    Dim Dossier As String
 
    'défini la feuille
    Set Fe = ActiveSheet
 
    'dossier où seront enregistré les fichiers pdf
    Dossier = "D:\Feuille en PDF\"
 
    With Fe
 
        'dernière ligne et colonne utilisée
        DerLigne = .Cells(.Rows.Count, 2).End(xlUp).Row 'sur colonne B -> adresses e-mail
 
        DerColonne = .Cells(1, .Columns.Count).End(xlToLeft).Address(0, 0) '.Column 'sur ligne 1 --> entêtes
 
        DerColonne = Left(DerColonne, Len(DerColonne) - 1) 'supprime le chiffre 1
 
        'défini la plage sur la colonne F (destinataires)
        Set Plage = .Range(.Cells(1, 6), .Cells(.Rows.Count, 6).End(xlUp))
 
        'parcourt la plage et cache les colonnes et lignes en fonction du destinataire
        'ici, une colonne dédiée à la zone pourrait rendre le code plus souple plutôt que d'entrer
        'les plages en "dur" dans le code
        For Each Cel In Plage
 
            Select Case Cel.Value
 
                Case "Monsieur X" 'B32:F34
 
                    .Columns("A:A").EntireColumn.Hidden = True
                    .Columns("G:" & DerColonne).EntireColumn.Hidden = True
                    .Rows("1:31").EntireRow.Hidden = True
                    .Rows("35:" & DerLigne).EntireRow.Hidden = True
 
                Case "Monsieur Y" 'D51:H54
 
                    .Columns("A:C").EntireColumn.Hidden = True
                    .Columns("I:Z").EntireColumn.Hidden = True
                    .Rows("1:50").EntireRow.Hidden = True
                    .Rows("55:200").EntireRow.Hidden = True
 
            End Select
 
            'exporte la feuille en "pdf" dans la dossier avec pour nom, le nom du destinataire
            .ExportAsFixedFormat xlTypePDF, Dossier & Cel.Value, 0, True
 
            'affiche à nouveau toutes les colonnes et lignes
            .Rows.EntireRow.Hidden = False
            .Columns.EntireColumn.Hidden = False
 
            'construction du message
            Corps = "Bonjour," & vbCrLf & vbCrLf
            Corps = Corps & "Veuillez trouver ci-joint les valeurs comme convenu." & vbCrLf & vbCrLf
            Corps = Corps & "Cordialement." & vbCrLf & vbCrLf
            Corps = Corps & "balibou."
 
            'création du message
            Set Outlook = CreateObject("Outlook.Application")
            Set Message = Outlook.CreateItem(0)
 
            With Message
 
                .To = Cel.Offset(0, -4).Value
                .Subject = "Envoi de valeurs"
                .Body = Corps
                .Attachments.Add Dossier & Cel.Value & ".pdf" '<-- en pièce jointe, le fichier pdf correspondant
                .Display
                .Send
 
            End With
 
        Next Cel
 
    End With
 
End Sub

Hervé.

Re,

Pour finir, j'ai fait une proc qui est sur le même principe que la précédente à la différence que les plages qui doivent être visibles sont indiquées dans une colonne de la feuille et non en "dur" dans le code, ici, en colonne S et entrées de la façon suivante B10:G15. Il t'es possible d'utiliser une fonction perso du genre ci-dessous pour retourner l'adresse de la plage après une sélection :

Code:

1
2
3
4
5
6
7
8
 
Function ADRESSEPALGE(Plage As Range)
 
    Application.Volatile
 
    ADRESSEPALGE = (Plage.Address(0, 0))
 
End Function

Le code avec les adresses de plages en feuille Excel :

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
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
 
Sub EnvoiMail()
 
    Dim Fe As Worksheet
    Dim Outlook As Object
    Dim Message As Object
    Dim Plage As Range
    Dim Cel As Range
 
    Dim DerLigne As Long
    Dim DerColonne As String
 
    Dim Corps As String
    Dim Dossier As String
 
    Dim CelDebut As String
    Dim CelFin As String
    Dim Col1 As String
    Dim Col2 As String
    Dim Lng1 As String
    Dim Lng2 As String
 
    Dim I As Integer
 
    Dim ErrCol As Boolean
    Dim ErrLgn As Boolean
 
    'défini la feuille
    Set Fe = ActiveSheet
 
    'dossier où seront enregistré les fichiers pdf
    Dossier = "D:\Feuille en PDF\"
 
    With Fe
 
        'dernière ligne et colonne utilisée
        DerLigne = .Cells(.Rows.Count, 2).End(xlUp).Row 'sur colonne B -> adresses e-mail
 
        DerColonne = .Cells(1, .Columns.Count).End(xlToLeft).Address(0, 0) '.Column 'sur ligne 1 --> entêtes
 
        DerColonne = Left(DerColonne, Len(DerColonne) - 1) 'supprime le chiffre 1
 
        'défini la plage sur la colonne F (destinataires)
        Set Plage = .Range(.Cells(1, 6), .Cells(.Rows.Count, 6).End(xlUp))
 
        'parcourt la plage et cache les colonnes et lignes en fonction du destinataire
        For Each Cel In Plage
 
            'récupère dans la colonne S l'adresse des plages qui doivent être visibles
            CelDebut = Split(Cel.Offset(0, 13).Value, ":")(0)
            CelFin = Split(Cel.Offset(0, 13).Value, ":")(1)
 
            'mise en place d'un gestionnaire pour gérer l'erreur due à la colonne A ou la ligne 1
            'NOTE : n'est pas géré ici la dernière ligne et la dernière colonne car pratiquement jamais utilisées. Si il faut gérer, il suffit de partir sur le même principe
            On Error Resume Next
 
            'cellule pour le masquage gauche et haut défini par un
            'décalage d'une colonne à gauche et d'une ligne au dessus
            CelDebut = Range(CelDebut).Offset(0, -1).Address(0, 0) '1 colonne vers la gauche
 
            If Err.Number <> 0 Then ErrCol = True 'si erreur, colonne A
 
            Err.Number = 0
 
            CelDebut = Range(CelDebut).Offset(-1, 0).Address(0, 0) '1 ligne vers le haut
 
            If Err.Number <> 0 Then ErrLgn = True 'si erreur, ligne 1
 
            'supprime le gestionnaire
            On Error GoTo 0
 
            'cellule pour le masquage droit et bas
            CelFin = Range(CelFin).Offset(1, 1).Address(0, 0)
 
            'scinde les lettres de colonnes et les numéros de lignes
            For I = 1 To Len(CelDebut)
 
                If IsNumeric(Mid(CelDebut, I, 1)) Then
 
                    Col1 = Left(CelDebut, I - 1)
                    Lng1 = Right(CelDebut, Len(CelDebut) - (I - 1))
 
                    Exit For
 
                End If
 
            Next I
 
            For I = 1 To Len(CelFin)
 
                If IsNumeric(Mid(CelFin, I, 1)) Then
 
                    Col2 = Left(CelFin, I - 1)
                    Lng2 = Right(CelFin, Len(CelFin) - (I - 1))
 
                    Exit For
 
                End If
 
            Next I
 
            'si une erreur c'est produite sur le décalage de colonne
            'il n'y aura pas de masquage du coté gauche
            If ErrCol = False Then
 
                .Columns("A:" & Col1).EntireColumn.Hidden = True
 
            End If
 
            'si une erreur c'est produite sur le décalage de ligne
            'il n'y aura pas de masquage du coté haut
            If ErrLgn = False Then
 
                .Rows("1:" & Lng1).EntireRow.Hidden = True
 
            End If
 
            'masquage coté droit
            .Columns(Col2 & ":" & DerColonne).EntireColumn.Hidden = True
 
            'masquage coté bas
            .Rows(Lng2 & ":" & DerLigne).EntireRow.Hidden = True
 
            'exporte la feuille en "pdf" dans la dossier avec pour nom, le nom du destinataire
            .ExportAsFixedFormat xlTypePDF, Dossier & Cel.Value, 0, True
 
            'affiche à nouveau toutes les colonnes et lignes
            .Rows.EntireRow.Hidden = False
            .Columns.EntireColumn.Hidden = False
 
            'construction du message
            Corps = "Bonjour," & vbCrLf & vbCrLf
            Corps = Corps & "Veuillez trouver ci-joint les valeurs comme convenu." & vbCrLf & vbCrLf
            Corps = Corps & "Cordialement." & vbCrLf & vbCrLf
            Corps = Corps & "balibou."
 
            'création du message
            Set Outlook = CreateObject("Outlook.Application")
            Set Message = Outlook.CreateItem(0)
 
            With Message
 
                .To = Cel.Offset(0, -4).Value
                .Subject = "Envoi de valeurs"
                .Body = Corps
                .Attachments.Add Dossier & Cel.Value & ".pdf" '<-- en pièce jointe, le fichier pdf correspondant
                .Display
                .Send
 
            End With
 
        Next Cel
 
    End With
 
End Sub

Hervé.

Après des heures de galères j'ai finalement opté pour une méthode avec HTML Body :)

Cependant je block sur un dernier point, je n'arrive pas à faire un set après un autofilter sur 2 fields différents (alors qu'avec un seul field cela marche nickel).

C'est un tableau qui est en A27: D472, je veux filtrer la 3eme et la 5eme colonne, et faire un set sur le tableau filtré mais ca marche pas :( (j'ai essayé avec criteria "yes" et "=yes" et "=*yes*")
Code:

1 2 3 4 5 6 7 ActiveSheet.AutoFilterMode = True ActiveSheet.Range("A27:D472").AutoFilter Field:=3, Criteria1:=LCase(Cells(Cell.Row, "F").Value) ActiveSheet.Range("A27:D472").AutoFilter Field:=5, Criteria1:="=yes", Operator:=xlFilterValues Set rng = ActiveSheet.Range("A27:D472")

05/03/2013, 15h15
balibou

Finalement c'était un problème de case mergée ... tout marche impec :)

Merci à vous tous ! :)