Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Envoyer une feuille du classeur par Email

Envoyer une feuille du classeur par Email

2 réponses
Avatar
crole
Bonjour le groupe :-)

Je souhaiterais savoir comment adapter le code ci-dessous pour envoyer
par email uniquement la feuille active et non le classeur (sans faire
r=E9f=E9rence =E0 l'onglet) est-ce possible

Private Sub CommandButton1_Click()

' ENVOI PAR E-MAIL DU FICHIER :
Dim MonOutlook As Object
Dim MonMessage As Object
Set MonOutlook =3D CreateObject("Outlook.Application")
Set MonMessage =3D MonOutlook.createitem(0)
MonMessage.to =3D "bdc.bruno@skynet.be"
MonMessage.cc =3D " "
MonMessage.bcc =3D " "
MonMessage.Attachments.Add "H:\Confidentiel\Le brin de
Causette\Rapport journalier.xls"
MonMessage.Subject =3D "Rapport journalier"
Corps =3D "Bonjour,"
Corps =3D Corps & Chr(13) & Chr(10) ' Retour chariot
Corps =3D Corps & Chr(13) & Chr(10) ' Retour chariot
Corps =3D Corps & "Voici le fichier contenant les Rapports Journalier."
Corps =3D Corps & Chr(13) & Chr(10) ' Retour chariot
Corps =3D Corps & Chr(13) & Chr(10) ' Retour chariot
Corps =3D Corps & "Le Brin de Causette"
Corps =3D Corps & Chr(13) & Chr(10) ' Retour chariot
Corps =3D Corps & Chr(13) & Chr(10) ' Retour chariot
Corps =3D Corps & "Ce message a =E9t=E9 verifi=E9 par l'Antivirus System
Avast! Mail."
MonMessage.body =3D Corps
MonMessage.send
Set MonOutlook =3D Nothing

End Sub

Merci au groupe pour les r=E9ponses
Bruno
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
J
Bonjour crole
la sub suivante de Andrew envoie uniquement la feuille active
@+
J@@
'*****
Private Sub MailSheet()
On Error GoTo Terminator
Dim shtName As String, fName As Variant
shtName = ActiveSheet.Name
ActiveSheet.Copy
Set fName = ActiveWorkbook
fName.SaveAs Filename:=Application.GetSaveAsFilename("Copie de " &
shtName, _
"Microsoft Excel File, *.xls", , "Mail Sheet")
If fName.Name = "FALSE.xls" Then GoTo DeleteBook
With Application
.DisplayAlerts = False
.Dialogs(xlDialogSendMail).Show
End With
DeleteBook:
With ActiveWorkbook
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Terminator:
Application.DisplayAlerts = True
End Sub
'****


Bonjour le groupe :-)

Je souhaiterais savoir comment adapter le code ci-dessous pour envoyer
par email uniquement la feuille active et non le classeur (sans faire
référence à l'onglet) est-ce possible

Private Sub CommandButton1_Click()

' ENVOI PAR E-MAIL DU FICHIER :
Dim MonOutlook As Object
Dim MonMessage As Object
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.createitem(0)
MonMessage.to = ""
MonMessage.cc = " "
MonMessage.bcc = " "
MonMessage.Attachments.Add "H:ConfidentielLe brin de
CausetteRapport journalier.xls"
MonMessage.Subject = "Rapport journalier"
Corps = "Bonjour,"
Corps = Corps & Chr(13) & Chr(10) ' Retour chariot
Corps = Corps & Chr(13) & Chr(10) ' Retour chariot
Corps = Corps & "Voici le fichier contenant les Rapports Journalier."
Corps = Corps & Chr(13) & Chr(10) ' Retour chariot
Corps = Corps & Chr(13) & Chr(10) ' Retour chariot
Corps = Corps & "Le Brin de Causette"
Corps = Corps & Chr(13) & Chr(10) ' Retour chariot
Corps = Corps & Chr(13) & Chr(10) ' Retour chariot
Corps = Corps & "Ce message a été verifié par l'Antivirus System
Avast! Mail."
MonMessage.body = Corps
MonMessage.send
Set MonOutlook = Nothing

End Sub

Merci au groupe pour les réponses
Bruno



Avatar
JB
Bonjour,

http://www.excelabo.net/moteurs/compteclic.php?nom=jb-envoipagemail

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

Cordialement JB