Excel: modification macro d'envoie de mail

[Résolu]
Signaler
Messages postés
13
Date d'inscription
jeudi 23 février 2012
Statut
Membre
Dernière intervention
27 mars 2013
-
Messages postés
13
Date d'inscription
jeudi 23 février 2012
Statut
Membre
Dernière intervention
27 mars 2013
-
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.

7 réponses

Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
239
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
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
239
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
Messages postés
13
Date d'inscription
jeudi 23 février 2012
Statut
Membre
Dernière intervention
27 mars 2013

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.
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
239
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
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
239
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
Messages postés
13
Date d'inscription
jeudi 23 février 2012
Statut
Membre
Dernière intervention
27 mars 2013

la cellule E13 contient une adresse e-mail (dupont.dupont@fourniseur.fr).
Messages postés
13
Date d'inscription
jeudi 23 février 2012
Statut
Membre
Dernière intervention
27 mars 2013

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.