Sub Envoi_mail()
Dim Inc As Integer, i&, sNomFic As String, sNoms As String
Dim Obj As Object
Dim Ol As Object, Olmail As MailItem, ListeTo As String, liste As String
Application.ScreenUpdating = False
sNomFic = ThisWorkbook.FullName ' pour envoyer le classeur actif
With Feuil1
If .CheckBox1.Value = True Then sNoms = .Range("N4").Value
' Pour chaque objet de la feuille
For Each Obj In .OLEObjects
' Si le nom de l'objet commence par Check et que ce n'est pas le premier
If Left(Obj.Name, 5) = "Check" And Obj.Name <> "CheckBox1" And Obj.Name <> "CheckBox2" Then
' Récupérer le numéro du checkbox
Inc = Right(Obj.Name, Len(Obj.Name) - InStr(1, Obj.Name, "x"))
If Obj.Object.Value = True Then sNoms = sNoms & " " & .Cells(4, 14 + ((Inc - 2) * 3)).Value
End If
Next Obj
End With
Set Ol = New Outlook.Application
Set Olmail = Ol.CreateItem(olMailItem)
For i = 6 To Feuil1.Range("j65536").End(xlUp).Row
If Cells(i, 10).Value = "" Then ListeTo = ListeTo & Cells(i, 11).Value
If Cells(i, 10).Value = "X" Then liste = liste & Cells(i, 11).Value & ";"
Next i
With Olmail
.To = ListeTo
.BCC = liste
.Subject = "Message de Jacky"
.Body = " Bonjour," & vbCrLf & " Voici le fichier de pré-Inscription pour " & sNoms _
& vbCrLf & " à remplir et à me renvoyer " & vbCrLf & " Sportivement " & vbCrLf & " @ Bientôt " & vbCrLf & " Jacky "
.Attachments.Add sNomFic
.Display
End With
End Sub
Sub Envoi_mail1()
Dim Ol As New Outlook.Application, Olmail As MailItem, CurrFile$, nom$, dest$, fin&, i&, a&, liste$, n&
Set Ol = New Outlook.Application
Set Olmail = Ol.CreateItem(olMailItem)
Application.ScreenUpdating = False
'nom = ThisWorkbook.FullName ' si un jour Jacky tu veux envoyer le fichier avec
With Feuil1
fin = Feuil1.Range("I" & Rows.Count).End(xlUp).Row
For i = 5 To fin
If .Cells(i, 12) <> "" Then dest = dest & .Cells(i, 13) & ";"
Next i
If dest = "" Then MsgBox "Vous n'avez choisi aucune Adresse", , "Pas de destinataire": Exit Sub
dest = Mid(dest, 1, Len(dest) - 1)
End With
With Olmail
.To = dest
.CC = liste
.Subject = "Message de Jacky"
.Body = "Bonjour," & vbCrLf & " @ Bientôt " & vbCrLf & " Jacky "
'.Attachments.Add nom 'Jacky si un jour tu modifies pour envoyer un fichier tu retires le ' en début de ligne
.Display
End With
End Sub