code à modifier

Version imprimable

code à modifier

Bonjour,

Voici un code que l'on m'a fait pour envoyer des mails

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub Envoi_mail()
    Dim Ol As New Outlook.Application, Olmail As MailItem, CurrFile$, nom$, dest$, fin&, i&, a&, liste$, n&, nn&
    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("F" & Rows.Count).End(xlUp).Row
        For i = 5 To fin
            If .Cells(i, 5) <> "" And .Cells(i, 5).Font.ColorIndex = 3 Then dest = dest & .Cells(i, 6) & ";": nn = nn + 1
        Next i
        If nn = 0 Then MsgBox "Vous n'avez pas choisi de destinataire" & vbCrLf & _
        "Vous devez avoir au moins une Croix rouge dans la liste" & vbCrLf & _
        "La ou les Croix rouge sont les destinataires, les noirs sont le Copies Conformes", , "Destinataire de l'envoi": Exit Sub
1       For a = 5 To fin
            If .Cells(a, 5) <> "" And .Cells(a, 5).Font.ColorIndex <> 3 Then liste = liste & .Cells(a, 6) & ";"
        Next a
        dest = Mid(dest, 1, Len(dest) - 1)
        liste = Mid(liste, 1, Len(liste) - 1)
    End With
    With Olmail
        .To = dest
        .CC = liste
        .Subject = "Message de Jacky"
        .Body = "Bonjour c'est Jacky," & vbCrLf & "Et tu mets ce que tu veux....."
        '.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

mais je voudrais savoir ce qu'il faut changer pour décaller de 2 colonnes vers la droite
merci
jac

21/05/2011, 13h32
pgz

Bonjour.

Je ne sais pas trop ce que tu veux dire, mais à chaque fois que tu lis une cellule, tu changes l'indice colonne, par exemple .cells(a,5) devient .Cells(a,7).

PGZ
21/05/2011, 16h55
patricktoulon

heu !!!

bonjour
si je comprend bien ta macro tu envoie un mail a plusieurs destinataires en fonction des cellules et plusieurs accusés de réception le but c'est quoi??:koi:

Bonjour
Code nettoyé

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub Envoi_mail()
Dim Ol As New Outlook.Application
Dim Olmail As MailItem
Dim Nom As String, Dest As String, List As String
Dim i As Long, Fin As Long, n As Long
 
 
Application.ScreenUpdating = False
Set Olmail = Ol.CreateItem(olMailItem)
Nom = ThisWorkbook.FullName ' si un jour Jacky tu veux envoyer le fichier avec
With Feuil1
    Fin = .Cells(.Rows.Count, "F").End(xlUp).Row
    For i = 5 To Fin
        With .Range("G" & i)  'G:Colonne des croix
            If .Value <> "" Then
                If .Font.ColorIndex = 3 Then
                    Dest = Dest & ";" & .Offset(0, 1).Value
                    n = n + 1
                Else
                    List = List & ";" & .Offset(0, 1).Value
                End If
            End If
        End With
    Next i
    If n = 0 Then
        MsgBox "Vous n'avez pas choisi de destinataire" & vbCrLf & _
            "Vous devez avoir au moins une Croix rouge dans la liste" & vbCrLf & _
            "La ou les Croix rouge sont les destinataires, les noirs sont le Copies Conformes", _
            , "Destinataire de l'envoi"
    Else
        Dest = Mid(Dest, 2)
        List = Mid(List, 2)
        With Olmail
            .To = Dest
            .CC = List
            .Subject = "Message de Jacky"
            .Body = "Bonjour c'est Jacky," & vbCrLf & "Et tu mets ce que tu veux....."
            '.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 If
End With
Set Olmail = Nothing
Set Ol = Nothing
End Sub

22/05/2011, 19h58
jacfld49

bonsoir et merci, cela fonctionne
cordialement
jac