Erreure sur code mail feuille active

Bonour

j'ai un petit soucis sur un code pour un envoie d'une feuille active par mail sans passé par une messagerie donc un evoie direct comme gmail

Jusque la me code fonctionne bien , mais ou je corse c'est au niveau de la feuille active j'ai du mal à l'intégré

'Se code me pose problème il m'ouvre outlook et insèere ma feuille active ( je veux pas passé par outlook)

ActiveWorkbook

Application.DisplayAlerts = False

ActiveWorkbook.Close 'ferme la copie de la feuille active

Bonjour,

Essaie ceci :

Option Explicit
Public Sub CDO_Mail_ActiveSheet()
Dim wbSource As Workbook, wbNew As Workbook
Dim FileExtStr As String, TempFilePath As String, TempFileName As String
Dim FileFormatNum As Long
Dim iMsg As Object, iConf As Object
Dim Flds As Variant

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wbSource = ActiveWorkbook
    ' Copie la feuille active dans un nouveau classeur.
    ActiveSheet.Copy
    ' Ou si vous voulez copier plusieurs feuilles. Utilisez :
    ' wbSource.Sheets(Array("Sheet1", "Sheet3")).Copy
    Set wbNew = ActiveWorkbook
    ' On détermine la version Excel et l'extension du fichier / Format
    With wbNew
        If Val(Application.Version) < 12 Then
            ' Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            ' 2007-2010
            ' On sort de la procédure dans le cas les macros sont désactivées.
            ' *** cas ou cette procédure est lancée d'un autre classeur (ex : Personal.xlsb).***
            If wbSource.Name = .Name Then
                Application.EnableEvents = True
                MsgBox "Vous n'avez pas activé les macros."
                Exit Sub
            Else
                Select Case wbSource.FileFormat
                    Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                    Case 52:
                        If .HasVBProject Then
                            FileExtStr = ".xlsm": FileFormatNum = 52
                        Else
                            FileExtStr = ".xlsx": FileFormatNum = 51
                        End If
                    Case 56: FileExtStr = ".xls": FileFormatNum = 56
                    Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With
    ' Sauve le nouveau classeur, poste le message et supprime le fichier temporaire crée.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & wbSource.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    With wbNew
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        MsgBox TempFilePath & TempFileName & FileExtStr
        .Close savechanges:=False
    End With

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    iConf.Load -1    ' Source par défaut CDO
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "emetteur@xxx.com" ' à modifier
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "motdepasse" ' à modifier
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With

    With iMsg
        Set .Configuration = iConf
        .To = "destinataire@xxx.com" 'à modifier
        .CC = ""
        .BCC = ""
        .From = """emetteur"" <emetteur@xxx.com>" ' à modifier
        .Subject = "Message important" ' à modifier
        .TextBody = "Bonjour," & vbCrLf 'à modifier
        .AddAttachment TempFilePath & TempFileName & FileExtStr
        .Send
    End With

    'Supprime le fichier envoyé.
    Kill TempFilePath & TempFileName & FileExtStr

    Application.EnableEvents = True

    Set Flds = Nothing
    Set iConf = Nothing
    Set iMsg = Nothing
    Set wbNew = Nothing: Set wbSource = Nothing

End Sub

Bonsoir,

Je vais testé cela demain et je te tien au courant

Cordialement

KIRA

Re,Jean-Eric

Salut,j'ai testé ton code, et cela fonctionne impect merci pour ton aide et si je veux envoyer le classeur entier dans ton code

je met ceci

Set wbSource = ActiveWorkbook par thisworkbook

ActiveSheet.Copy par thisworkbook .copy

Bonjour,

wbSource.Copy

Pense à clore le sujet.

Bonne fêtes de fin d'années.