XL 2013 Insérer une plage de cellules dans le corps d'un mail outlook

[ZEUGMA2010]

Bonjour,
Débutant en VBA, je n'arrive pas à finaliser mon projet.
Je souhaite envoyer, individuellement, un message OUTLOOK (Sheets "MESSAGE" Plage D2:K9) aux correspondants dont la case est cochée (Sheets "MAIRIES").
Ma conditionnelle "si case cochée alors" ne fonctionne pas.
Je souhaiterai aussi pouvoir ajouter au mail une adresse mail en Cc.
Merci.

 

[kiki29]

Salut, va voir sur le site de Ron de Bruin

 

[Lolote83]

BONJOUR ZEUGMA2010,

J'ai revu la code du lancement des mails.

Sub MAIL()
    '------------------------------------------------------------------------------
    '                                                                  ESSAI1 Macro
    '------------------------------------------------------------------------------
    Application.ScreenUpdating = False          ' accélérateur Macro
    
    '--------------------------------------------------------------
    '                                     Déclaration des variables
    '--------------------------------------------------------------
    Dim Chemin
    Dim DerniereLigne
    Dim i As Integer
    Dim NomFichier
    Dim DerniereLigneMessage

    Chemin = Application.ActiveWorkbook.Path     'C:\Users\Phuy031\Desktop\ELECTIONS NEW"
    
    
    With Sheets("MAIRIES")
        DerniereLigne = .Cells(Rows.Count, 3).End(xlUp).Row
        For i = 2 To DerniereLigne
            xMailTo = .Range("I" & i).Value
            xMailCc = .Range("J" & i).Value
            If .Cells(i, 1).Value = True Then
                
                'Sheets("MESSAGE").Activate
                
                With Sheets("MESSAGE")
                    
                    NomFichier = .Range("B5").Value
                    xSujet = .Range("B2").Value
                    DerniereLigneMessage = .Cells(Rows.Count, 4).End(xlUp).Row
                    '.Range("D2:D" & DerniereLigneMessage).Select  ' la plage de cellules à envoyer
                    .Select
                    ActiveWorkbook.EnvelopeVisible = True
                    With .MailEnvelope
                        .Introduction = "bonjour, ( " & Sheets("MAIRIES").Range("K" & i).Value & " )"
                        .Item.Subject = xSujet
                        .Item.To = xMailTo
                        .Item.CC = xMailCc
                        '.Item.Attachments.Add ActiveWorkbook.Path & "\" & NomFichier & ".PDF"
                        .Item.Send
                    End With
                End With
            End If
        '-----------------------------------------------------------------------------------------------------------
        Next i
    End With
    
    Range("B3").Select
    MsgBox "Message(s) transmis", , "Je vous informe..."
    
    '
End Sub

Cela devrait fonctionner
Cordialement
Lolote83

 

[ZEUGMA2010]

Salut, va voir sur le site de Ron de Bruin

Bonjour kiki 29,
Merci pour l'info. je vais étudier cela.
Cordialement

 

[ZEUGMA2010]

BONJOUR ZEUGMA2010,

J'ai revu la code du lancement des mails.

Sub MAIL()
    '------------------------------------------------------------------------------
    '                                                                  ESSAI1 Macro
    '------------------------------------------------------------------------------
    Application.ScreenUpdating = False          ' accélérateur Macro
   
    '--------------------------------------------------------------
    '                                     Déclaration des variables
    '--------------------------------------------------------------
    Dim Chemin
    Dim DerniereLigne
    Dim i As Integer
    Dim NomFichier
    Dim DerniereLigneMessage

    Chemin = Application.ActiveWorkbook.Path     'C:\Users\Phuy031\Desktop\ELECTIONS NEW"
   
   
    With Sheets("MAIRIES")
        DerniereLigne = .Cells(Rows.Count, 3).End(xlUp).Row
        For i = 2 To DerniereLigne
            xMailTo = .Range("I" & i).Value
            xMailCc = .Range("J" & i).Value
            If .Cells(i, 1).Value = True Then
               
                'Sheets("MESSAGE").Activate
               
                With Sheets("MESSAGE")
                   
                    NomFichier = .Range("B5").Value
                    xSujet = .Range("B2").Value
                    DerniereLigneMessage = .Cells(Rows.Count, 4).End(xlUp).Row
                    '.Range("D2:D" & DerniereLigneMessage).Select  ' la plage de cellules à envoyer
                    .Select
                    ActiveWorkbook.EnvelopeVisible = True
                    With .MailEnvelope
                        .Introduction = "bonjour, ( " & Sheets("MAIRIES").Range("K" & i).Value & " )"
                        .Item.Subject = xSujet
                        .Item.To = xMailTo
                        .Item.CC = xMailCc
                        '.Item.Attachments.Add ActiveWorkbook.Path & "\" & NomFichier & ".PDF"
                        .Item.Send
                    End With
                End With
            End If
        '-----------------------------------------------------------------------------------------------------------
        Next i
    End With
   
    Range("B3").Select
    MsgBox "Message(s) transmis", , "Je vous informe..."
   
    '
End Sub

Cela devrait fonctionner
Cordialement
Lolote83

Bonjour Lolote83,
Impeccable, merci pour cette correction qui me permettra de travailler plus efficacement.
J'étais vraiment perdu dans mes recherches sur le Net.
Cordialement.