MikeBelgique
XLDnaute Occasionnel
Bonjour les Excelliens,
Je reviens vers vous pour résoudre mon problème qui est le suivant.
J'utilise un événement associé à un commandbouton pour envoyé par mail une feuille, elle fonctionne parfaitement bien.
Private Sub CommandButton2_Click()
NomDuClasseur$ = "TEST.xlsm" 'nom fich.temp qui sera effacé après !
NomDeLaFeuille$ = "ESSAIS" '<<<<<<<<<<<<<< ici nom de ta feuille à envoyer ?
Select Case Range("A1")
Case "ESSAISENTEST"
AdresMaildestin$ = "BELZEBUT@SERVEUR.COM" '<<< ici adresse destinataire ?
End Select
AdresMailCC$ = "" ' <<<<<<<<<<<<<<<<<<<<< ici adresses CC s'il y a !?
AdresMailBCC$ = "" ' <<<<<<<<<<<<<<<<<<<<< ici adresses BCC s'il y a !?
Sujet$ = " " & ActiveSheet.Name
'-------------------------------------------------------------------------------
' .
' ci-dessous normalement il n'y a rien à modifier ! .
' .
' Copie la feuille (ce qui cré un nouveau classeur qui devient actif)
Dim retou As String
MsgBox "VOUS ETES SUR LE POINT D'ENVOYER LA FEUILLE ESSAIS!!!", vbInformation, ""
retou = MsgBox("ETES VOUS DE VOULOIR ENVOYER LA FEUILLE ?", vbYesNo, "INSCRIPTION; POUR ENVOI !!")
If retou = vbYes Then
Dim OutApp As Object, OutMail As Object, NewB As Workbook, CheminFichier$
CheminFichier$ = ThisWorkbook.Path & "\" & NomDuClasseur$ 'ajoute le chemin
Sheets(NomDeLaFeuille$).Copy
Set NewB = ActiveWorkbook
ActiveWorkbook.SaveAs CheminFichier$, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
' ENVOI
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error GoTo ErreurNET
With OutMail
.To = AdresMaildestin$
.CC = AdresMailCC$
.BCC = AdresMailBCC$
.Subject = Sujet$
.Attachments.Add NewB.FullName
.send
End With
' close le classeur et le supprime du disque
ActiveWorkbook.Close
Kill CheminFichier$
' fin
Set OutApp = Nothing: Set OutMail = Nothing: Set NewB = Nothing
On Error GoTo 0: Err.Clear
MsgBox "Message envoyé !", vbInformation, ""
Exit Sub
ErreurNET: ' sous prog erreur
Msg$ = "Erreur " & Err.Source & " No " & Err.Number & vbLf & vbLf & Err.Description
t$ = "Envoi Mail: Problème de connexion !?"
MsgBox Msg$, vbCritical, t$, Err.Helpfile, Err.HelpContext
On Error GoTo 0: Err.Clear
End If
End Sub
MAIS sur la dernière feuille pour laquelle j'aurais souhaité utiliser à nouveau ce code j'ai un bug "erreur de compilation, sub ou fonction non définie" au moment ou la copie de la feuille dans le nouveau classeur est effectuée et juste avant l'envoi par mail car en début j'ai un code qui appelle une macro lors de l'activation de la feuille
Private Sub WORKsheet_activate()
Call Regroupe2
End Sub
Comment puis je à partir de la copie de la feuille dans le nouveau classeur suspendre l'exécution de cette dernière.
En vous remerciant d'avance pour votre aide.
Mike
Je reviens vers vous pour résoudre mon problème qui est le suivant.
J'utilise un événement associé à un commandbouton pour envoyé par mail une feuille, elle fonctionne parfaitement bien.
Private Sub CommandButton2_Click()
NomDuClasseur$ = "TEST.xlsm" 'nom fich.temp qui sera effacé après !
NomDeLaFeuille$ = "ESSAIS" '<<<<<<<<<<<<<< ici nom de ta feuille à envoyer ?
Select Case Range("A1")
Case "ESSAISENTEST"
AdresMaildestin$ = "BELZEBUT@SERVEUR.COM" '<<< ici adresse destinataire ?
End Select
AdresMailCC$ = "" ' <<<<<<<<<<<<<<<<<<<<< ici adresses CC s'il y a !?
AdresMailBCC$ = "" ' <<<<<<<<<<<<<<<<<<<<< ici adresses BCC s'il y a !?
Sujet$ = " " & ActiveSheet.Name
'-------------------------------------------------------------------------------
' .
' ci-dessous normalement il n'y a rien à modifier ! .
' .
' Copie la feuille (ce qui cré un nouveau classeur qui devient actif)
Dim retou As String
MsgBox "VOUS ETES SUR LE POINT D'ENVOYER LA FEUILLE ESSAIS!!!", vbInformation, ""
retou = MsgBox("ETES VOUS DE VOULOIR ENVOYER LA FEUILLE ?", vbYesNo, "INSCRIPTION; POUR ENVOI !!")
If retou = vbYes Then
Dim OutApp As Object, OutMail As Object, NewB As Workbook, CheminFichier$
CheminFichier$ = ThisWorkbook.Path & "\" & NomDuClasseur$ 'ajoute le chemin
Sheets(NomDeLaFeuille$).Copy
Set NewB = ActiveWorkbook
ActiveWorkbook.SaveAs CheminFichier$, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
' ENVOI
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error GoTo ErreurNET
With OutMail
.To = AdresMaildestin$
.CC = AdresMailCC$
.BCC = AdresMailBCC$
.Subject = Sujet$
.Attachments.Add NewB.FullName
.send
End With
' close le classeur et le supprime du disque
ActiveWorkbook.Close
Kill CheminFichier$
' fin
Set OutApp = Nothing: Set OutMail = Nothing: Set NewB = Nothing
On Error GoTo 0: Err.Clear
MsgBox "Message envoyé !", vbInformation, ""
Exit Sub
ErreurNET: ' sous prog erreur
Msg$ = "Erreur " & Err.Source & " No " & Err.Number & vbLf & vbLf & Err.Description
t$ = "Envoi Mail: Problème de connexion !?"
MsgBox Msg$, vbCritical, t$, Err.Helpfile, Err.HelpContext
On Error GoTo 0: Err.Clear
End If
End Sub
MAIS sur la dernière feuille pour laquelle j'aurais souhaité utiliser à nouveau ce code j'ai un bug "erreur de compilation, sub ou fonction non définie" au moment ou la copie de la feuille dans le nouveau classeur est effectuée et juste avant l'envoi par mail car en début j'ai un code qui appelle une macro lors de l'activation de la feuille
Private Sub WORKsheet_activate()
Call Regroupe2
End Sub
Comment puis je à partir de la copie de la feuille dans le nouveau classeur suspendre l'exécution de cette dernière.
En vous remerciant d'avance pour votre aide.
Mike