XL 2016 Code vba envoi mail classeur excel

[Benoooiiiittttt]

Bonjour,
Voilà plusieurs jours que j’essaie de résoudre mon problème via les divers forum mais ça ne marche pas. Le problème restant sur le code ci-dessous : Lorsque j’exécute le code j'ai 2 fenêtres outlook qui s'ouvrent. 1 fenêtre avec le classeur entier(mais il manque le texte d'accompagnement), la 2eme s'ouvre avec seulement la feuille active mais avec le texte..Pouvez-vous m'indiquer la résolution à mon problème afin d'avoir 1 seul mail prêt à envoyer avec le classeur entier et le texte d'accompagnement? Merci d'avance
Le code:
[/CODE]

 

[Compte Supprimé 979]

Bonjour,

C'est certain qu'en vous y prenant comme ça, sans vérifier votre post... vous allez aller loin

J'ose espérer qu'en plus vous n'avez pas fait de cross posting !?

A+

 

[Benoooiiiittttt]

Sub suite()
Pardon, le code:
Sub mail ()
If MsgBox("SOUHAITEZ-VOUS ENVOYER LE POINT CA PAR EMAIL ?" & Chr(13) & Chr(10) & "( Une nouvelle fenètre OUTLOOK va être ouverte )", 36, "Envoyer Email") = vbYes Then
  
    Dim OL As Object, myItem As Object, wDoc As Object, Rng As Object
    Dim Fichier As String, plage_mail As Range
    Set OL = CreateObject("Outlook.Application")
    Set myItem = OL.CreateItem(olMailItem)
    Set wDoc = myItem.GetInspector.WordEditor
    Set FL = Worksheets("Feuil1!")
    Set plage_mail = Worksheets("Feuil1!").Range("A1:K29")
            
    Workbooks("Monfichier.xlsm").Activate
    ActiveWorkbook.SendMail Recipients:=Range("c258954").Value
        Application.DisplayAlerts = True
 
    
  
    With myItem
        .To = ListeTo
        .Subject = "Blablabla"
        .Body = Worksheets("Base").Range("L6")
        .Attachments.Add Application.ActiveWorkbook.FullName
        .Display
        plage_mail.Copy
        Set Rng = wDoc.Content
        Rng.InsertParagraphAfter
        Rng.Move 4, 1
        Rng.Paste
        Rng.Move 4
        
            
           End With

End If
    
    Set OL = Nothing: Set myItem = Nothing: Set wDoc = Nothing
    'Remonte à la cellule de Sélection du Magasin
    Range("A1").Activate

End Sub

Function ListeTo()
    xCpt = 0
    With Sheets("Base")
        For Each xCell In .Range("C5")
            xCpt = xCpt + 1
            If xCpt = 1 Then
                xTo = xCell
            Else
                xTo = xTo & ";" & xCell
            End If
        Next xCell
    End With
    ListeTo = xTo
End Function


Private Sub CommandButton1_Click()

End Sub

 

[Compte Supprimé 979]

Re,

Vous auriez pu éditer votre 1er post et mettre le code dedans

A essayer et tester

Option Explicit

Const olMailItem As Integer = 0

Sub mail()
  Dim Fl As Worksheet
  Dim OL As Object, myItem As Object, wDoc As Object, Rng As Object
  Dim Fichier As String, Plage_Mail As Range

  If MsgBox("SOUHAITEZ-VOUS ENVOYER LE POINT CA PAR EMAIL ?" & vbCr _
          & "( Une nouvelle fenètre OUTLOOK va être ouverte )", vbYesNo, "Envoyer Email") = vbNo Then Exit Sub
 
  Set OL = CreateObject("Outlook.Application")
  Set myItem = OL.CreateItem(olMailItem)
  Set wDoc = myItem.GetInspector.WordEditor
  Set Fl = Worksheets("Feuil1!")
  Set Plage_Mail = Worksheets("Feuil1!").Range("A1:K29")
 
  With myItem
    .Display
    .To = ListeTo
    .Subject = "Blablabla"
    .Body = Worksheets("Base").Range("L6")
    Plage_Mail.Copy
    Set Rng = wDoc.Content
    Rng.InsertParagraphAfter
    Rng.Move 4, 1
    Rng.Paste
    Rng.Move 4
    .Attachments.Add Application.ActiveWorkbook.FullName
  End With

  Set OL = Nothing: Set myItem = Nothing: Set wDoc = Nothing
  'Remonte à la cellule de Sélection du Magasin
  Range("A1").Activate
End Sub

Function ListeTo()
  Dim xCell As Range, xCpt As Integer, xTo As String
  xCpt = 0
  With Sheets("Base")
    For Each xCell In .Range("C5")
      xCpt = xCpt + 1
      If xCpt = 1 Then
        xTo = xCell
      Else
        xTo = xTo & ";" & xCell
      End If
    Next xCell
  End With
  ListeTo = xTo
End Function

A+

 

[Benoooiiiittttt]

Merci pour la réponse très rapide. J'ai fait une mauvaise manip sur le premier envoi.

Je viens de tester, il me met une erreur de compilation variable non définie. En surlignant en bleu xCell de la ligne For each dans Function ListeTo (). Je suis novice en vba, je souhaite seulement automatiser un envoi pour gagner du temps. Merci pour ton aide

 

[Compte Supprimé 979]

Re,

"Option Explicit" nous oblige à déclarer nos variables, ce qui est mieux en général

J'ai corrigé le code, il manquait la définition de xCell

A+

 

[Benoooiiiittttt]

Le code fonctionne mais je n'ai que la Feuille 1 en pj du mail alors que je souhaite mettre le classeur entier. Est-ce qu'il y a une correction à faire ?