Public c, cel, r, rg
Sub Envoi_mail()
Dim CurrFile$, nom$, i&, j&
Application.ScreenUpdating = False
nom = ThisWorkbook.FullName ' pour envoyer le classeur actif
With Feuil1
If .CheckBox1.Value = True Then
Set rg = Range("n4")
n = rg.Value
End If
End With
With Feuil1
If .CheckBox3.Value = True Then
Set rg = Range("p4")
p = rg.Value
End If
End With
With Feuil1
If .CheckBox4.Value = True Then
Set rg = Range("r4")
r = rg.Value
End If
End With
With Feuil1
If .CheckBox5.Value = True Then
Set rg = Range("t4")
t = rg.Value
End If
End With
With Feuil1
If .CheckBox6.Value = True Then
Set rg = Range("v4")
v = rg.Value
End If
End With
With Feuil1
If .CheckBox7.Value = True Then
Set rg = Range("x4")
x = rg.Value
End If
With Feuil1
End With
With Feuil1
If .CheckBox8.Value = True Then
Set rg = Range("z4")
Z = rg.Value
End If
End With
With Feuil1
If .CheckBox9.Value = True Then
Set rg = Range("ab4")
ab = rg.Value
End If
End With
With Feuil1
If .CheckBox10.Value = True Then
Set rg = Range("ad4")
ad = rg.Value
End If
End With
With Feuil1
If .CheckBox11.Value = True Then
Set rg = Range("af4")
af = rg.Value
End If
End With
If .CheckBox12.Value = True Then
Set rg = Range("ah4")
ah = rg.Value
End If
End With
With Feuil1
If .CheckBox13.Value = True Then
Set rg = Range("aj4")
aj = rg.Value
End If
End With
With Feuil1
If .CheckBox14.Value = True Then
Set rg = Range("al4")
al = rg.Value
End If
End With
With Feuil1
If .CheckBox15.Value = True Then
Set rg = Range("an4")
an = rg.Value
End If
End With
With Feuil1
If .CheckBox16.Value = True Then
Set rg = Range("ap4")
ap = rg.Value
End If
End With
With Feuil1
If .CheckBox17.Value = True Then
Set rg = Range("ar4")
ar = rg.Value
End If
End With
With Feuil1
If .CheckBox18.Value = True Then
Set rg = Range("at4")
at = rg.Value
End If
End With
With Feuil1
If .CheckBox18.Value = True Then
Set rg = Range("av4")
av = rg.Value
End If
End With
With Feuil1
If .CheckBox19.Value = True Then
Set rg = Range("ax4")
ax = rg.Value
End If
End With
With Feuil1
If .CheckBox20.Value = True Then
Set rg = Range("az4")
aZ = rg.Value
End If
End With
With Feuil1
If .CheckBox21.Value = True Then
Set rg = Range("bb4")
bb = rg.Value
End If
End With
With Feuil1
If .CheckBox22.Value = True Then
Set rg = Range("bd4")
bd = rg.Value
End If
End With
With Feuil1
If .CheckBox23.Value = True Then
Set rg = Range("bf4")
bf = rg.Value
End If
End With
With Feuil1
If .CheckBox24.Value = True Then
Set rg = Range("bh4")
bh = rg.Value
End If
End With
With Feuil1
If .CheckBox25.Value = True Then
Set rg = Range("bj4")
bj = rg.Value
End If
End With
With Feuil1
If .CheckBox26.Value = True Then
Set rg = Range("bl4")
bl = rg.Value
End If
End With
With Feuil1
If .CheckBox27.Value = True Then
Set rg = Range("bn4")
bn = rg.Value
End If
End With
With Feuil1
If .CheckBox28.Value = True Then
Set rg = Range("bp4")
bp = rg.Value
End If
End With
With Feuil1
If .CheckBox29.Value = True Then
Set rg = Range("br4")
br = rg.Value
End If
End With
With Feuil1
If .CheckBox30.Value = True Then
Set rg = Range("bt4")
bt = rg.Value
End If
End With
With Feuil1
If .CheckBox31.Value = True Then
Set rg = Range("bv4")
bv = rg.Value
End If
End With
With Feuil1
If .CheckBox32.Value = True Then
Set rg = Range("bx4")
bx = rg.Value
End If
End With
With Feuil1
If .CheckBox33.Value = True Then
Set rg = Range("bz4")
bz = rg.Value
End If
End With
With Feuil1
If .CheckBox34.Value = True Then
Set rg = Range("cb4")
cb = rg.Value
End If
End With
With Feuil1
If .CheckBox35.Value = True Then
Set rg = Range("cd4")
cd = rg.Value
End If
End With
Dim Ol As New Outlook.Application, Olmail As MailItem, _
ListeTo As String, liste As String
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 " & " " & n & "" & p & "" & r & "" & t & "" & v & "" & x & "" & Z & "" & ab & "" & ad & "" & af & "" & ah & "" & aj & "" & al & "" & an & "" & ap & "" & ar & "" & at & "" & av & "" & ax & "" & aZ & "" & bb & "" & bd & "" & bf & "" & bh & "" & bj & "" & bl & "" & bn & "" & bp & "" & br & "" & bt & "" & bv & "" & bx & "" & bz & "" & cb & "" & cd & "" & vbCrLf & " à remplir et à me renvoyer " & vbCrLf & " Sportivement " & vbCrLf & " @ Bientôt " & vbCrLf & " Jacky "
.Attachments.Add nom
.Display
End With
End Sub