Bonjour, j'utilise votre code pour envoyer une plage Excel en pièce jointe, mais j'obtiens une erreur d'exécution si j'annule la plage. Y a-t-il du code que je peux ajouter ou une msgbox s'il vous plaît pour éviter que cela ne se produise? Merci code ci-dessous.
Sous SendRange()
Estomper xFile en tant que chaîne
Dim xFormat aussi longtemps
Dim Wb comme classeur
Dim Wb2 en tant que classeur
Feuille de travail Dim Ws As
Dim FilePath en tant que chaîne
Dim FileName As String
Dim OutlookApp en tant qu'objet
Dim OutlookMail en tant qu'objet
Dim WorkRng comme plage
xTitleId = "Exemple"
Set WorkRng = Application.Selection
Définir WorkRng = Application.InputBox("Plage", xTitleId, WorkRng.Address, Type :=8)
Application.ScreenUpdating = Faux
Application.DisplayAlerts = Faux
Définir Wb = Application.ActiveWorkbook
Wb.Worksheets.Add
Définir Ws = Application.ActiveSheet
WorkRng.Copie Ws.Cells(1, 1)
Ws. Copier
Définir Wb2 = Application.ActiveWorkbook
Sélectionnez Case Wb.FileFormat
Cas xlOpenXMLWorkbook :
xFichier = ".xlsx"
xFormat = xlOpenXMLWorkbook
Cas xlOpenXMLWorkbookMacroEnabled :
Si Wb2.HasVBProject Alors
xFichier = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
autre
xFichier = ".xlsx"
xFormat = xlOpenXMLWorkbook
Si fin
Cas Excel8 :
xFichier = ".xls"
xFormat = Excel8
Cas xlExcel12 :
xFichier = ".xlsb"
xFormat = xlExcel12
End Select
CheminFichier = Environ$("temp") & "\"
FileName = Wb.Name & Format (Maintenant, "jj-mmm-aa h-mm-ss")
Set OutlookApp = CreateObject("Outlook.Application")
Définir OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
Avec OutlookMail
.To = "gtest@email.com"
.CC = ""
.BCC = ""
.Sujet = "Tests"
.Body = "Salut . "
.Pièces jointes.Ajouter Wb2.FullName
.Envoyer
Terminer par
Wb2.Fermer
Tuer FilePath & FileName & xFile
Définir OutlookMail = Rien
Définir OutlookApp = Rien
Ws.Supprimer
Application.DisplayAlerts = Vrai
Application.ScreenUpdating = True
End Sub
Sous SendRange()
Estomper xFile en tant que chaîne
Dim xFormat aussi longtemps
Dim Wb comme classeur
Dim Wb2 en tant que classeur
Feuille de travail Dim Ws As
Dim FilePath en tant que chaîne
Dim FileName As String
Dim OutlookApp en tant qu'objet
Dim OutlookMail en tant qu'objet
Dim WorkRng comme plage
xTitleId = "Exemple"
Set WorkRng = Application.Selection
Définir WorkRng = Application.InputBox("Plage", xTitleId, WorkRng.Address, Type :=8)
Application.ScreenUpdating = Faux
Application.DisplayAlerts = Faux
Définir Wb = Application.ActiveWorkbook
Wb.Worksheets.Add
Définir Ws = Application.ActiveSheet
WorkRng.Copie Ws.Cells(1, 1)
Ws. Copier
Définir Wb2 = Application.ActiveWorkbook
Sélectionnez Case Wb.FileFormat
Cas xlOpenXMLWorkbook :
xFichier = ".xlsx"
xFormat = xlOpenXMLWorkbook
Cas xlOpenXMLWorkbookMacroEnabled :
Si Wb2.HasVBProject Alors
xFichier = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
autre
xFichier = ".xlsx"
xFormat = xlOpenXMLWorkbook
Si fin
Cas Excel8 :
xFichier = ".xls"
xFormat = Excel8
Cas xlExcel12 :
xFichier = ".xlsb"
xFormat = xlExcel12
End Select
CheminFichier = Environ$("temp") & "\"
FileName = Wb.Name & Format (Maintenant, "jj-mmm-aa h-mm-ss")
Set OutlookApp = CreateObject("Outlook.Application")
Définir OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
Avec OutlookMail
.To = "gtest@email.com"
.CC = ""
.BCC = ""
.Sujet = "Tests"
.Body = "Salut . "
.Pièces jointes.Ajouter Wb2.FullName
.Envoyer
Terminer par
Wb2.Fermer
Tuer FilePath & FileName & xFile
Définir OutlookMail = Rien
Définir OutlookApp = Rien
Ws.Supprimer
Application.DisplayAlerts = Vrai
Application.ScreenUpdating = True
End Sub