Excel: modification macro d'envoie de mail Résolu

Question

J'utilise une macro trouvée sur un forum pour envoyer des mails via excel, j'aimerais cependant la modifier pour mieux l'adapter à mes besoins. 




Sub Mail_Selection()
    Dim source As Range
    Dim ColumnCount As Long
    Dim FirstColumn As Long
    Dim ColumnWidthArray() As Double
    Dim lIndex As Long
    Dim lCount As Long
    Dim dest As Workbook
    Dim i As Long
    Dim strdate As String
 
    Set source = Nothing
    On Error Resume Next
    Set source = Selection.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If source Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protect, please correct and try again.", vbOKOnly
        Exit Sub
    End If
    
Set source = Range("A15:M30").SpecialCells(xlCellTypeVisible)
Range("A15:M30").Select


    Application.ScreenUpdating = False
    ColumnCount = Selection.Columns.Count
    FirstColumn = Selection.Cells(1).Column - 1
    ReDim ColumnWidthArray(1 To ColumnCount)
    lIndex = 0
    For lCount = 1 To ColumnCount
        If Columns(FirstColumn + lCount).Hidden = False Then
            lIndex = lIndex + 1
            ColumnWidthArray(lIndex) = Columns(FirstColumn + lCount).ColumnWidth
        End If
    Next lCount
    Set dest = Workbooks.Add(xlWBATWorksheet)
    source.Copy
    With dest.Sheets(1)
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        For i = 1 To lIndex
            .Columns(i).ColumnWidth = ColumnWidthArray(i)
        Next
    End With
    strdate = Format(Now, "dd-mm-yy h-mm-ss")
    With dest
        .SaveAs "Selection of " & ThisWorkbook.Name _
              & " " & strdate & ".xls"
       SendMail "ron@debruin.nl", _    
        "This is the Subject line"
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .Close False
    End With
    Application.ScreenUpdating = True
End Sub
J'aimerais remplacer la ligne "SendMail "ron@debruin.nl", _ " car l'adresse email se trouve en cellule "e13" de la feuille active (nommée " mail ")
J'aimerais également rajouter du corps de texte dans le mail (juste une phrase bateau).

Je n'ai pas besoin qu'une copie / mise à jour du classeur soit effectué à chaque envoie.

Merci d'avance si vous pouvez m'indiquer les changements à effectuer.

ucfoutu · Accepted Answer

Bonjour, 
Hé bien : remplace donc "ron@debruin.nl" par sheets("mail").Range("E:13")
C'est là, vraiment, du rudimentaire de chez rudimentaire (qui donne à penser que tout le code que tu montres ici, bien plus complexe, a juste été copié/collé !)

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Je viens en plus de voir où tu as pêché, sans le comprendre, le bout de code que tu a montré !
office.11%29.aspx Tapez le texte de l'url ici.
J'ai lu ce lien en entier. Pas toi, apparemment, car tu y as plusieurs exemples clairs. Il te suffit de les  analyser , de comprendre, puis de faire ta propre recette, à ta propre sauce !


____________________
Réponse exacte ?  => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

gladou67 · Answer

Bonjour. 
Effectivement j'ai juste copié/collé cette macro parce que je n'ai aucune connaissance en VB. Pour ce qui est de lire visiblement je ne suis pas le seul à ne pas le faire (car "J'utilise une macro trouvée sur un forum" indique bien que je l'ai copié/collé), j'ai essayé de la comprendre et j'ai vu qu'il fallait remplacer la ligne que tu signales mais je ne savais pas quoi y mettre. J'avais déjà essayé ce que tu me proposes et si je me suis décidé à poster sur ce forume c'est justement parce que je ne trouvais pas comment remplacer cette ligne. J'ai essayé en combinant avec d'autres exemples (ActiveSheet.SendMail.Range("e13").Value , _  et autres fantaisies) mais je n'ai pas trouvé la formule magique.

ucfoutu · Answer

Hé bien : remplace donc "ron@debruin.nl" par sheets("mail").Range("E:13") 
ne peut que fonctionner, à condition, bien évidemment, que la cellule E13 concernée contienne, en texte,  l'adresse email en cause !


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Range("E13"), pardon.

Quel est donc le contenu exact de cette cellule E13 ? 


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

gladou67 · Answer

la cellule E13 contient une adresse e-mail (dupont.dupont@fourniseur.fr).

gladou67 · Answer

Sub Mail_Selection()
    Dim source As Range
    Dim ColumnCount As Long
    Dim FirstColumn As Long
    Dim ColumnWidthArray() As Double
    Dim lIndex As Long
    Dim lCount As Long
    Dim dest As Workbook
    Dim i As Long
    Dim strDate As String
 
    Set source = Nothing
    On Error Resume Next
    Set source = Selection.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If source Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protect, please correct and try again.", vbOKOnly
        Exit Sub
    End If
    
Set source = Range("A13:M30").SpecialCells(xlCellTypeVisible)
Range("A13:M30").Select


    Application.ScreenUpdating = False
    ColumnCount = Selection.Columns.Count
    FirstColumn = Selection.Cells(1).Column - 1
    ReDim ColumnWidthArray(1 To ColumnCount)
    lIndex = 0
    For lCount = 1 To ColumnCount
        If Columns(FirstColumn + lCount).Hidden = False Then
            lIndex = lIndex + 1
            ColumnWidthArray(lIndex) = Columns(FirstColumn + lCount).ColumnWidth
        End If
    Next lCount
    Set dest = Workbooks.Add(xlWBATWorksheet)
    source.Copy
    With dest.Sheets(1)
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        For i = 1 To lIndex
            .Columns(i).ColumnWidth = ColumnWidthArray(i)
        Next
    End With
    strDate = Format(Now, "dd-mm-yy h-mm-ss")
    With dest
    ActiveWorkbook.SendMail ActiveSheet.Range("e1").Value, _
        "TITRE DU MAIL"
        .Close False
    End With
    Application.ScreenUpdating = True
End Sub

J'ai compris d'où venait l'erreur, un nouveau classeur était créer et ma cellule qui contenait l'adresse mail se retrouvait de e13 à e1. J'ai aussi supprimer les lignes relatives à l'enregistrement du document vu que je n'en ait pas besoin. J'ai essayé de rajouter du texte dans le corps du mail avec du   .Body = "texte" mais je ne sais pas où le mettre.

Excel: modification macro d'envoie de mail

7 réponses

Votre réponse

Discussions similaires