Macro VBA cellules actives + onglet actif en PJ

Bonjour,

Je souhaite, à partir d'un document excel envoyer un mail a chaque email présente dans la colonne "b", avec le texte qui va avec, dans la colonne C:

B C

Pierre Bonjour Pierre

Paul Bonjour Paul

Jaques Bonjour Jaques

1 er email :

TO: Pierre

Body : Bonjour Pierre

2e email:

TO: Paul

Body: Bonjour Paul

La deuxième partie de la macro, doit ajouter l'onglet de travail excel sur lequel je travaille (uniquement).

J'ai trouvé un code pour cette partie, qui marche parfaitement, mais je ne trouve pas le moyen d'intégrer la premiere partie de ma demande (inserer les cellules dans l'email crée).

Pourriez vous m'aider SVPPPP.

Voici le code pour copier l'onglet actif dans l'email:

Sub Mail_ActiveSheet()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object

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

    Set Sourcewb = ActiveWorkbook

    ' Next, copy the sheet to a new workbook.
    ' You can also use the following line, instead of using the ActiveSheet object,
   ' if you know the name of the sheet you want to mail :
    ' Sheets("Sheet5").Copy
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    ' Determine the Excel version, and file extension and format.
    With Destwb
        If Val(Application.Version) < 12 Then
            ' For Excel 2000-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            ' For Excel 2007-2010, exit the subroutine if you answer
            ' NO in the security dialog that is displayed when you copy
            ' a sheet from an .xlsm file with macros disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "You answered NO in the security dialog."
                Exit Sub
            Else
                Select Case Sourcewb.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

    ' You can use the following statements to change all cells in the
   ' worksheet to values.
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False

    ' Save the new workbook, mail, and then delete it.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = " " & Sourcewb.Name & " " _
                 & Format(Now, "dd-mmm-yy")

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
       ' Change the mail address and subject in the macro before
       ' running the procedure.
        With OutMail
            .To = "grandac@airproducts.com"
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = "Hello World!"
            .Attachments.Add Destwb.FullName
            ' You can add other files by uncommenting the following statement.
            '.Attachments.Add ("C:\test.txt")
            ' In place of the following statement, you can use ".Display" to
            ' display the mail.
            .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    ' Delete the file after sending.
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Bonjour,

un exemple pour 10 destinataires, à tester.

Cordialement

12clemgdd-test.xlsm (19.71 Ko)

Bonjour,

C'est parfait, c'est ce que je voulais mais ... aurais tu une solution pour que le nombre de destinataires ne soit pas prédéfini ?

Il y a des mois ou je vais avoir 10 destinataires, mais le mois d'après 5 , puis 50 , puis 9 ...

le top serait de mettre une "condition" : envoyer des mails que quand la cellule est pleine ..

Saurais tu faire ca ?

Merci beaucoup pour ton aide!!!

Bonjour,

je te prépare ça.

Re bonjour,

version jusqu'à 100 destinataires max,

sinon faire évoluer cette ligne de code

For a = 1 To Range("B100").End(xlUp).Row 'Destinataires de 1 à 100
5clemgdd-test2.xlsm (20.48 Ko)

C'est parfait merci, mais dernier problème, je n'arrive pas a choisir les bonnes colonnes pour lancer ma macro : dans l'exemple, j'ai dit les colonnes B et C , alors que dans mon document c'est C pour le destinataire et le body sera dans une autre colonne ..

J'ai changé les lettres dans la macro mais ça ne change pas

Pour l'adresse en colonne C, tu changes cette partie du code :

For a = 1 To Range("C100").End(xlUp).Row 'Destinataires de 1 à 100
      Range("C" & a).Select
      If Not IsEmpty(Range("C" & a)) = True Then Call mail
    Next a

Pour le .Body, il faut adapter cette ligne :

        .body = ActiveCell.Offset(0, 1)
  • le 0 signifie qu'on est sur la même ligne
  • la valeur 1 correspond à un décalage de 1 vers la droite par rapport à la cellule où est l'adresse mail

ca marche très mal, je ne comprends pas !!!

J'ai modifié ton code comme tu l'as dit, mais maintenant tout dépend de la cellule selectionnée par la souris ..... !!!!!! je n'obtiens plus le bon résultat, plus de boucle, plus rien ...

Je t'envoie mon fichier, si tu peux trouver la solution directement dessus ca serait top !

Il faut envoyer a "C", le body "T" :

TO: Pierre

Body: BONJOUR PIERRE

7template.xlsx (9.64 Ko)

La macro pour lancer la procédure de mail est cell_pleine

En pièce jointe la macro adaptée à tes besoins.

Rechercher des sujets similaires à "macro vba actives onglet actif"