Envoi dans Corps de Mail

[piwa]

Bonjour,

JE dispose d'un code parfait pour envoyer une PJ via outlook et par Macro, je souhaite non pas envoyer une PJ mais une copie d'une zone selectionnée dans une feuille et la je coince.

Voila le code initial
Sub envoi_Feuille()
**répertoireAppli = ActiveWorkbook.Path
**Sheets("résultats").Copy
**Application.DisplayAlerts = False
**ActiveWorkbook.SaveAs répertoireAppli & "\Resultats.xls"
**ActiveWindow.Close
**'--- Envoi par mail
**Dim olapp As Outlook.Application
**Sheets("destinataires").Select
**Range("A11").Select
**Do While Not IsEmpty(ActiveCell)
*****Dim msg As MailItem
*****Set olapp = New Outlook.Application
*****Set msg = olapp.CreateItem(olMailItem)
*****msg.To = ActiveCell.Value
*****msg.Subject = Range("A2").Value
*****msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13)
*****msg.Attachments.Add Source:=répertoireAppli & "\Resultats.xls"
*****msg.Send
*****ActiveCell.Offset(1, 0).Select
**Loop
End Sub


Merci de votre Aide

 

[Manu62]

Re : Envoi dans Corps de Mail

Bonjour,

c'est le genre de chose que je fais. Par contre faut il que le destinataire modifie quelque chose, ou c'est juste en lecture.

Manu

 

[piwa]

Re : Envoi dans Corps de Mail

Merci de ton aide Manu

C'est juste en Lecture, en fait j'ai une feuille avec des tableaux et des graphiques et je veux l'envoyer direct dans le corps du mail sans passer par une PJ. Le destinataire voit ainsi en Direct ses resultats du jour. En manuel je selectionne la feuille enitiere puis Copier je passe dans outlook coller et c'est fini ....

Merci encore de ton aide

 

[tototiti2008]

Re : Envoi dans Corps de Mail

Bonjour à tous,

à priori, si l'utilisateur a sélectionné la plage à copier avant de lancer la macro, un truc comme ça

Sub envoi_Feuille()
Dim Wkb1 as Workbook, Wkb2 as workbook
**set Wkb1 = Activeworkbook
**répertoireAppli = Wkb1.Path
**Set Wkb2 = workbooks.add
**wkb1.activate
**Selection.Copy wkb2.activesheet.range("A1")
**Application.DisplayAlerts = False
**Wkb2.SaveAs répertoireAppli & "\Resultats.xls"
**Wkb2.Close false
**'--- Envoi par mail
**Dim olapp As Outlook.Application
**Sheets("destinataires").Select
**Range("A11").Select
**Do While Not IsEmpty(ActiveCell)
*****Dim msg As MailItem
*****Set olapp = New Outlook.Application
*****Set msg = olapp.CreateItem(olMailItem)
*****msg.To = ActiveCell.Value
*****msg.Subject = Range("A2").Value
*****msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13)
*****msg.Attachments.Add Source:=répertoireAppli & "\Resultats.xls"
*****msg.Send
*****ActiveCell.Offset(1, 0).Select
**Loop
End Sub

Edit : Oups, j'avais compris de travers, encore une fois... désolé

 

[piwa]

Re : Envoi dans Corps de Mail

Bonjour à tous,

à priori, si l'utilisateur a sélectionné la plage à copier avant de lancer la macro, un truc comme ça

Sub envoi_Feuille()
Dim Wkb1 as Workbook, Wkb2 as workbook
**set Wkb1 = Activeworkbook
**répertoireAppli = Wkb1.Path
**Set Wkb2 = workbooks.add
**wkb1.activate
**Selection.Copy wkb2.activesheet.range("A1")
**Application.DisplayAlerts = False
**Wkb2.SaveAs répertoireAppli & "\Resultats.xls"
**Wkb2.Close false
**'--- Envoi par mail
**Dim olapp As Outlook.Application
**Sheets("destinataires").Select
**Range("A11").Select
**Do While Not IsEmpty(ActiveCell)
*****Dim msg As MailItem
*****Set olapp = New Outlook.Application
*****Set msg = olapp.CreateItem(olMailItem)
*****msg.To = ActiveCell.Value
*****msg.Subject = Range("A2").Value
*****msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13)
*****msg.Attachments.Add Source:=répertoireAppli & "\Resultats.xls"
*****msg.Send
*****ActiveCell.Offset(1, 0).Select
**Loop
End Sub

Edit : Oups, j'avais compris de travers, encore une fois... désolé

??? j'ai toujours une PJ avec cette modif ? et dans msg.body je n'ai pas ma copie (plage de cellule)

OU j'ai loupé un truc et ca c'est possible

 

[tototiti2008]

Re : Envoi dans Corps de Mail

Bonjour à tous,

En effet, j'avais compris une pièce jointe avec seulement la copie des cellules sélectionnées...
désolé