By gwentaylor le lundi 29 mars 2021
Publié dans Excel
Réponses 0
Aime 0
Vues 2.8K
Votes 0
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
 
Voir l'article complet