tinet
XLDnaute Impliqué
Bonjour le forum,
jusqu'à maintenant mon fichier envoyait par messagerie la pièce jointe.
j'aurais besoin de modifier la formule pour garder les mêmes fonctions, mais au lieu d'envoyer le fichier mettre la feuilles appelée BEV en tant que corps du message uniquement et plus le fichier.
voici mon code, mais si vous avez besoin du fichier je peux vous l'envoyer.
A plus le forum
jusqu'à maintenant mon fichier envoyait par messagerie la pièce jointe.
j'aurais besoin de modifier la formule pour garder les mêmes fonctions, mais au lieu d'envoyer le fichier mettre la feuilles appelée BEV en tant que corps du message uniquement et plus le fichier.
voici mon code, mais si vous avez besoin du fichier je peux vous l'envoyer.
PHP:
Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path
Sheets("BEV").Copy
ActiveSheet.Unprotect Password:="PP"
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("F:F").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
ActiveSheet.Shapes("Button 1").Select
Selection.Delete
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\BEV.xls"
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Outlook.Application
Sheets("BEV").Select
Range("F11").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("F2").Value
msg.Body = Range("F5").Value & Chr(13) & Chr(13) & Range("F8").Value & Chr(13) & Chr(13)
msg.Attachments.Add Source:=répertoireAppli & "\BEV.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End SubA plus le forum
Dernière édition: