J'ai un probl=E8me sur une boucle pour communiquer avec outlook depuis
Excel, avec une condition.
Mon tableau est simple, Titres Colonnes :
A =3D Nom
B=3D Pr=E9nom
C=3D Adresse Mail
D =E0 F =3D autres information concernant le Nom
G =E0 W =3D des References articles
X =3D Total Articles
Y=3D Commande modifiee pour raison bug=E9taire
Sur Chaque ligne, les infos correspondent aux titres des colonnes, et
pour les colonnes de G =E0 W =3D nombre d'article de la r=E9f=E9rence artic=
le
et colonne Y =3D M si modifi=E9, et vide si pas modifi=E9.
Ma condition : si valeur "M" en colonne Y, alors envoi d'un mail avec
message informant l'interess=E9 qu'il y a eu modification de sa demande,
si vide, confirmation de la commande. (Juste le corps du texte d'intro
qui change)
La boucle, pour qu'il me fasse un mail pour chacune des lignes et en
fonction de la colonne Y, et j'ai =E9crit ceci :
Sub ConfirmationCommande()
Sheets("RECAP").Select
'Cr=E9ation doublon feuille
Sheets("RECAP").Copy Before:=3DSheets(1)
Sheets("RECAP (2)").Activate
'Suppression Filtre
Range("A1:X1").Select
Application.CutCopyMode =3D False
Selection.AutoFilter
'Remise en forme Texte et Titre
Range("G1:X1").Select
With Selection
.HorizontalAlignment =3D xlGeneral
.VerticalAlignment =3D xlBottom
.Orientation =3D 0
.AddIndent =3D False
.IndentLevel =3D 0
.ShrinkToFit =3D False
.ReadingOrder =3D xlContext
.MergeCells =3D False
End With
Range("G1").Select
ActiveCell.FormulaR1C1 =3D "Socle en bois - ""BLOC PRATIC"" sans
recharge"
Range("I1").Select
ActiveCell.FormulaR1C1 =3D "Agenda 22X14 - 1 jour =E0 la page
couverture cartonn=E9e"
Range("H1").Select
ActiveCell.FormulaR1C1 =3D "Recharge ""BLOC PRATIC"" - Date =E0
gauche"
Range("J1").Select
ActiveCell.FormulaR1C1 =3D "Agenda 35X15 - 1 jour =E0 la page
couverture cartonn=E9e"
Range("K1").Select
ActiveCell.FormulaR1C1 =3D "Calendrier bloc =E9ph=E9m=E9ride 8X10 sur
plaque"
Range("L1").Select
ActiveCell.FormulaR1C1 =3D "Planning vacances et absences D=E9cembre =
=E0
D=E9cembre"
Range("M1").Select
ActiveCell.FormulaR1C1 =3D "Calendrier cartonn=E9 21X29,7 6 mois sur
chaque face"
Range("N1").Select
ActiveCell.FormulaR1C1 =3D "Calendrier cartonn=E9 13X17 6 mois sur
chaque face"
Range("O1").Select
ActiveCell.FormulaR1C1 =3D "Guilplan 16X16 AGENDA DE BUREAU"
Range("P1").Select
ActiveCell.FormulaR1C1 =3D "811859" & Chr(10) & "Guilplan 16X24
AGENDA DE BUREAU" & Chr(10) & "1.04"
Range("P1").Select
ActiveCell.FormulaR1C1 =3D "Guilplan 16X24 AGENDA DE BUREAU"
Range("Q1").Select
ActiveCell.FormulaR1C1 =3D "Guilplan 21X27 AGENDA DE BUREAU"
Range("R1").Select
ActiveCell.FormulaR1C1 =3D "Guilplan 24X24 AGENDA DE BUREAU"
Range("W1").Select
'Comptage des lignes et envoi mail
Dim Nbligne As Long
Dim Outl As New Outlook.Application
Dim Olmail As MailItem
Dim i
i =3D ActiveCell.Row
Nbligne =3D Range("A2").CurrentRegion.Rows.Count
'Version texte si M en colonne Y
For i =3D Nbligne To 2 Step 1
If Cells("Y", i).Value =3D "M" Then
Set Outl =3D New Outlook.Application
Set Olmail =3D Outl.CreateItem(olMailItem)
With Olmail
.To =3D Range("C", i).Value
.Subject =3D "Votre Commande d'Agenda modifi=E9e"
.Body =3D "Bonjour," & Chr(13) _
& Chr(13) _
& "Veuillez trouver ci-dessous, votre Commande d'Agenda et de
Calendrier qui a =E9t=E9 modifi=E9e pour des raisons budg=E9taire, comme
suit :" & Chr(13) _
& Chr(13) _
& Range("G1").Value & " : " & Cells(i, "G").Value & Chr(13) _
& Range("H1").Value & " : " & Cells(i, "H").Value & Chr(13) _
& Range("I1").Value & " : " & Cells(i, "I").Value & Chr(13) _
& Range("J1").Value & " : " & Cells(i, "J").Value & Chr(13) _
& Range("K1").Value & " : " & Cells(i, "K").Value & Chr(13) _
& Range("L1").Value & " : " & Cells(i, "L").Value & Chr(13) _
& Range("M1").Value & " : " & Cells(i, "M").Value & Chr(13) _
& Range("N1").Value & " : " & Cells(i, "N").Value & Chr(13) _
& Range("O1").Value & " : " & Cells(i, "O").Value & Chr(13) _
& Range("P1").Value & " : " & Cells(i, "P").Value & Chr(13) _
& Range("Q1").Value & " : " & Cells(i, "Q").Value & Chr(13) _
& Range("R1").Value & " : " & Cells(i, "R").Value & Chr(13) _
& Range("S1").Value & " : " & Cells(i, "S").Value & Chr(13) _
& Range("T1").Value & " : " & Cells(i, "T").Value & Chr(13) _
& Range("U1").Value & " : " & Cells(i, "U").Value & Chr(13) _
& Range("V1").Value & " : " & Cells(i, "V").Value & Chr(13) _
& Range("W1").Value & " : " & Cells(i, "W").Value & Chr(13) _
& "=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D" &
Chr(13) _
& "TOTAL ARTICLE(S)" & " : " & Cells(i, "X").Value & Chr(13) _
& Chr(13) _
& "Cordialement," & Chr(13) & "Service Organisation Gestion"
.Send
End With
'Version si pas de M en colonne Y
Else:
Set Outl =3D New Outlook.Application
Set Olmail =3D Ol.CreateItem(olMailItem)
With Olmail
.To =3D Range("i,C").Value
.Subject =3D "Confirmation de votre Commande d'Agenda"
.Body =3D "Bonjour," & Chr(13) _
& Chr(13) _
& "Veuillez trouver ci-dessous, votre confirmation de Commande
d'Agenda et de Calendrier pour l'ann=E9e prochaine :" & Chr(13) _
& Chr(13) _
& Range("G1").Value & " : " & Cells(i, "G").Value & Chr(13) _
& Range("H1").Value & " : " & Cells(i, "H").Value & Chr(13) _
& Range("I1").Value & " : " & Cells(i, "I").Value & Chr(13) _
& Range("J1").Value & " : " & Cells(i, "J").Value & Chr(13) _
& Range("K1").Value & " : " & Cells(i, "K").Value & Chr(13) _
& Range("L1").Value & " : " & Cells(i, "L").Value & Chr(13) _
& Range("M1").Value & " : " & Cells(i, "M").Value & Chr(13) _
& Range("N1").Value & " : " & Cells(i, "N").Value & Chr(13) _
& Range("O1").Value & " : " & Cells(i, "O").Value & Chr(13) _
& Range("P1").Value & " : " & Cells(i, "P").Value & Chr(13) _
& Range("Q1").Value & " : " & Cells(i, "Q").Value & Chr(13) _
& Range("R1").Value & " : " & Cells(i, "R").Value & Chr(13) _
& Range("S1").Value & " : " & Cells(i, "S").Value & Chr(13) _
& Range("T1").Value & " : " & Cells(i, "T").Value & Chr(13) _
& Range("U1").Value & " : " & Cells(i, "U").Value & Chr(13) _
& Range("V1").Value & " : " & Cells(i, "V").Value & Chr(13) _
& Range("W1").Value & " : " & Cells(i, "W").Value & Chr(13) _
& "=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D" &
Chr(13) _
& "TOTAL ARTICLE(S)" & " : " & Cells(i, "X").Value & Chr(13) _
& Chr(13) _
& "Cordialement," & Chr(13) & "Service Organisation Gestion"
.Send
End With
End If
Next i
End Sub
Mais voil=E0, aucune boucle ne se fait et aucun mail part. J'ai tent=E9
sans condition, mais pas mieux - pas de boucle.
Merci par avance de votre aide.
Cordialement.
Alex
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Alex
On 28 juin, 11:56, Alex wrote:
Bonjour à tous,
J'ai un problème sur unebouclepour communiquer avecoutlookdepuis Excel, avec une condition. Mon tableau est simple, Titres Colonnes : A = Nom B= Prénom C= Adresse Mail D à F = autres information concernant le Nom G à W = des References articles X = Total Articles Y= Commande modifiee pour raison bugétaire
Sur Chaque ligne, les infos correspondent aux titres des colonnes, et pour les colonnes de G à W = nombre d'article de la référence art icle et colonne Y = M si modifié, et vide si pas modifié.
Ma condition : si valeur "M" en colonne Y, alors envoi d'un mail avec message informant l'interessé qu'il y a eu modification de sa demande, si vide, confirmation de la commande. (Juste le corps du texte d'intro qui change)
Laboucle, pour qu'il me fasse un mail pour chacune des lignes et en fonction de la colonne Y, et j'ai écrit ceci :
Sub ConfirmationCommande()
Sheets("RECAP").Select 'Création doublon feuille Sheets("RECAP").Copy Before:=Sheets(1) Sheets("RECAP (2)").Activate 'Suppression Filtre Range("A1:X1").Select Application.CutCopyMode = False Selection.AutoFilter 'Remise en forme Texte et Titre Range("G1:X1").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("G1").Select ActiveCell.FormulaR1C1 = "Socle en bois - ""BLOC PRATIC"" sans recharge" Range("I1").Select ActiveCell.FormulaR1C1 = "Agenda 22X14 - 1 jour à la page couverture cartonnée" Range("H1").Select ActiveCell.FormulaR1C1 = "Recharge ""BLOC PRATIC"" - Date à gauche" Range("J1").Select ActiveCell.FormulaR1C1 = "Agenda 35X15 - 1 jour à la page couverture cartonnée" Range("K1").Select ActiveCell.FormulaR1C1 = "Calendrier bloc éphéméride 8X10 sur plaque" Range("L1").Select ActiveCell.FormulaR1C1 = "Planning vacances et absences Décem bre à Décembre" Range("M1").Select ActiveCell.FormulaR1C1 = "Calendrier cartonné 21X29,7 6 mois sur chaque face" Range("N1").Select ActiveCell.FormulaR1C1 = "Calendrier cartonné 13X17 6 mois su r chaque face" Range("O1").Select ActiveCell.FormulaR1C1 = "Guilplan 16X16 AGENDA DE BUREAU" Range("P1").Select ActiveCell.FormulaR1C1 = "811859" & Chr(10) & "Guilplan 16X24 AGENDA DE BUREAU" & Chr(10) & "1.04" Range("P1").Select ActiveCell.FormulaR1C1 = "Guilplan 16X24 AGENDA DE BUREAU" Range("Q1").Select ActiveCell.FormulaR1C1 = "Guilplan 21X27 AGENDA DE BUREAU" Range("R1").Select ActiveCell.FormulaR1C1 = "Guilplan 24X24 AGENDA DE BUREAU" Range("W1").Select 'Comptage des lignes et envoi mail Dim Nbligne As Long Dim Outl As NewOutlook.Application Dim Olmail As MailItem Dim i i = ActiveCell.Row Nbligne = Range("A2").CurrentRegion.Rows.Count 'Version texte si M en colonne Y For i = Nbligne To 2 Step 1 If Cells("Y", i).Value = "M" Then Set Outl = NewOutlook.Application Set Olmail = Outl.CreateItem(olMailItem) With Olmail .To = Range("C", i).Value .Subject = "Votre Commande d'Agenda modifiée" .Body = "Bonjour," & Chr(13) _ & Chr(13) _ & "Veuillez trouver ci-dessous, votre Commande d'Agenda e t de Calendrier qui a été modifiée pour des raisons budgétaire, comme suit :" & Chr(13) _ & Chr(13) _ & Range("G1").Value & " : " & Cells(i, "G").Value & Chr(1 3) _ & Range("H1").Value & " : " & Cells(i, "H").Value & Chr(1 3) _ & Range("I1").Value & " : " & Cells(i, "I").Value & Chr(1 3) _ & Range("J1").Value & " : " & Cells(i, "J").Value & Chr(1 3) _ & Range("K1").Value & " : " & Cells(i, "K").Value & Chr(1 3) _ & Range("L1").Value & " : " & Cells(i, "L").Value & Chr(1 3) _ & Range("M1").Value & " : " & Cells(i, "M").Value & Chr(1 3) _ & Range("N1").Value & " : " & Cells(i, "N").Value & Chr(1 3) _ & Range("O1").Value & " : " & Cells(i, "O").Value & Chr(1 3) _ & Range("P1").Value & " : " & Cells(i, "P").Value & Chr(1 3) _ & Range("Q1").Value & " : " & Cells(i, "Q").Value & Chr(1 3) _ & Range("R1").Value & " : " & Cells(i, "R").Value & Chr(1 3) _ & Range("S1").Value & " : " & Cells(i, "S").Value & Chr(1 3) _ & Range("T1").Value & " : " & Cells(i, "T").Value & Chr(1 3) _ & Range("U1").Value & " : " & Cells(i, "U").Value & Chr(1 3) _ & Range("V1").Value & " : " & Cells(i, "V").Value & Chr(1 3) _ & Range("W1").Value & " : " & Cells(i, "W").Value & Chr(1 3) _ & "================== ========================= ============" & Chr(13) _ & "TOTAL ARTICLE(S)" & " : " & Cells(i, "X").Value & Chr( 13) _ & Chr(13) _ & "Cordialement," & Chr(13) & "Service Organisation Gesti on" .Send End With 'Version si pas de M en colonne Y Else: Set Outl = NewOutlook.Application Set Olmail = Ol.CreateItem(olMailItem) With Olmail .To = Range("i,C").Value .Subject = "Confirmation de votre Commande d'Agenda" .Body = "Bonjour," & Chr(13) _ & Chr(13) _ & "Veuillez trouver ci-dessous, votre confirmation de Com mande d'Agenda et de Calendrier pour l'année prochaine :" & Chr(13) _ & Chr(13) _ & Range("G1").Value & " : " & Cells(i, "G").Value & Chr(1 3) _ & Range("H1").Value & " : " & Cells(i, "H").Value & Chr(1 3) _ & Range("I1").Value & " : " & Cells(i, "I").Value & Chr(1 3) _ & Range("J1").Value & " : " & Cells(i, "J").Value & Chr(1 3) _ & Range("K1").Value & " : " & Cells(i, "K").Value & Chr(1 3) _ & Range("L1").Value & " : " & Cells(i, "L").Value & Chr(1 3) _ & Range("M1").Value & " : " & Cells(i, "M").Value & Chr(1 3) _ & Range("N1").Value & " : " & Cells(i, "N").Value & Chr(1 3) _ & Range("O1").Value & " : " & Cells(i, "O").Value & Chr(1 3) _ & Range("P1").Value & " : " & Cells(i, "P").Value & Chr(1 3) _ & Range("Q1").Value & " : " & Cells(i, "Q").Value & Chr(1 3) _ & Range("R1").Value & " : " & Cells(i, "R").Value & Chr(1 3) _ & Range("S1").Value & " : " & Cells(i, "S").Value & Chr(1 3) _ & Range("T1").Value & " : " & Cells(i, "T").Value & Chr(1 3) _ & Range("U1").Value & " : " & Cells(i, "U").Value & Chr(1 3) _ & Range("V1").Value & " : " & Cells(i, "V").Value & Chr(1 3) _ & Range("W1").Value & " : " & Cells(i, "W").Value & Chr(1 3) _ & "================== ========================= ============" & Chr(13) _ & "TOTAL ARTICLE(S)" & " : " & Cells(i, "X").Value & Chr( 13) _ & Chr(13) _ & "Cordialement," & Chr(13) & "Service Organisation Gesti on" .Send End With End If Next i End Sub
Mais voilà, aucunebouclene se fait et aucun mail part. J'ai tenté sans condition, mais pas mieux - pas deboucle.
Merci par avance de votre aide. Cordialement. Alex
Re Bonjour à tous, (Astuce et solution... lol) J'ai recherché et testé les différents conseils et solutions de mêm e type, mais rien n'a faire ...ça passait toujours pas!!!. Alors j'ai testé ma macro, mais cette fois ci, en idenquant que les cellules de la ligne 2, 1ère ligne de reference des mails à envoyer. Et cela a fonctionné tout de suite. J'ai alors procédé à un DO WHILE avec un controle de la valeur de la cellule C2 (adresse mai)l <> "" et ajouter après le .send une commande de suppression de la ligne 2.... Il faut bien entendu faire une copie de la feuille, sinon vous perdrez toutes les données... C bête lol (<= Ca c'était le côté Astuce )
Maintenant la solution : (Ca parrait long, mais c'est surtout du texte)
Sub ENVOI_MAIL_MULTIPLE()
Dim Ol As New Outlook.Application Dim Message As MailItem Dim Text As Object
Sheets("RECAP").Select 'Création doublon feuille Sheets("RECAP").Copy Before:=Sheets(1) Sheets("RECAP (2)").Activate 'Suppression Filtre Range("A1:X1").Select Application.CutCopyMode = False Selection.AutoFilter 'ENVOI MAIL DANS DO WHILE LOOP Sheets("RECAP (2)").Select Do While Range("C2").Value <> "" Set Ol = New Outlook.Application Set Message = Ol.CreateItem(olMailItem) With Message .To = Range("C2").Value .Subject = Range("Z2").Value .Body = "Bonjour," & Chr(13) _ & Chr(13) & Range("Y2") & Chr(13) & Chr(13) _ & "Socle en bois - ""BLOC PRATIC"" sans recharge : " & Range("G2").Value & Chr(13) _ & "Recharge ""BLOC PRATIC"" - Date à gauche : " & Range ("H2").Value & Chr(13) _ & "Agenda 22X14 - 1 jour à la page couverture cartonnée : " & Range("I2") & Chr(13) _ & "Agenda 35X15 - 1 jour à la page couverture cartonnée : " & Range("J2").Value & Chr(13) _ & "Calendrier bloc éphéméride 8X10 sur plaque : " & Range ("K2").Value & Chr(13) _ & "Planning vacances et absences Décembre à Décembre" & Range("L2").Value & Chr(13) _ & "Calendrier cartonné 21X29,7 6 mois sur chaque face" & Range("M2").Value & Chr(13) _ & "Calendrier cartonné 13X17 6 mois sur chaque face : " & Range("N2").Value & Chr(13) _ & "Guilplan - 16X16 - AGENDA DE BUREAU : " & Range ("O2").Value & Chr(13) _ & "Guilplan - 16X24 - AGENDA DE BUREAU : " & Range ("P2").Value & Chr(13) _ & "Guilplan - 21X27 - AGENDA DE BUREAU : " & Range ("Q2").Value & Chr(13) _ & "Guilplan - 24X24 - AGENDA DE BUREAU : " & Range ("R2").Value & Chr(13) _ & "Semaine Poche Temporel 16 - 16X8 : " & Range ("S2").Value & Chr(13) _ & "Recharge EXATIME 14 - 2J/P - 12X8 : " & Range ("T2").Value & Chr(13) _ & "Recharge EXATIME 17 - 1S/2P - 17X10 ; " & Range ("U2").Value & Chr(13) _ & "Recharge Semainier - OBER ""UP TO DAT"" - 48660 : " & Range("V2").Value & Chr(13) _ & "CALENDRIER SEMESTRIEL GMF - 36X43 : " & Range ("W2").Value & Chr(13) _ & "======================== ========================= ======================" & Chr(13) _ & "TOTAL ARTICLE(S) : " & Range("X2").Value & Chr(13) _ & Chr(13) _ & "Cordialement," & Chr(13) & "Service Organisation Gestion" .Send End With Rows("2:2").Select Selection.Delete Shift:=xlUp Range("C2").Select
Loop
Sheets("RECAP (2)").Select ActiveWindow.SelectedSheets.Delete End Sub
Voilà, j'espère que ca pourra être utile à quelqu'un, c'est ma fa çon de remercié toutes les personnes qui ont pu m'aider, ou m'aiguiller devant d'autres problèmes VBA. Cordialement. Alex
On 28 juin, 11:56, Alex <ale...@orange.fr> wrote:
Bonjour à tous,
J'ai un problème sur unebouclepour communiquer avecoutlookdepuis
Excel, avec une condition.
Mon tableau est simple, Titres Colonnes :
A = Nom
B= Prénom
C= Adresse Mail
D à F = autres information concernant le Nom
G à W = des References articles
X = Total Articles
Y= Commande modifiee pour raison bugétaire
Sur Chaque ligne, les infos correspondent aux titres des colonnes, et
pour les colonnes de G à W = nombre d'article de la référence art icle
et colonne Y = M si modifié, et vide si pas modifié.
Ma condition : si valeur "M" en colonne Y, alors envoi d'un mail avec
message informant l'interessé qu'il y a eu modification de sa demande,
si vide, confirmation de la commande. (Juste le corps du texte d'intro
qui change)
Laboucle, pour qu'il me fasse un mail pour chacune des lignes et en
fonction de la colonne Y, et j'ai écrit ceci :
Sub ConfirmationCommande()
Sheets("RECAP").Select
'Création doublon feuille
Sheets("RECAP").Copy Before:=Sheets(1)
Sheets("RECAP (2)").Activate
'Suppression Filtre
Range("A1:X1").Select
Application.CutCopyMode = False
Selection.AutoFilter
'Remise en forme Texte et Titre
Range("G1:X1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("G1").Select
ActiveCell.FormulaR1C1 = "Socle en bois - ""BLOC PRATIC"" sans
recharge"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Agenda 22X14 - 1 jour à la page
couverture cartonnée"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Recharge ""BLOC PRATIC"" - Date à
gauche"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Agenda 35X15 - 1 jour à la page
couverture cartonnée"
Range("K1").Select
ActiveCell.FormulaR1C1 = "Calendrier bloc éphéméride 8X10 sur
plaque"
Range("L1").Select
ActiveCell.FormulaR1C1 = "Planning vacances et absences Décem bre à
Décembre"
Range("M1").Select
ActiveCell.FormulaR1C1 = "Calendrier cartonné 21X29,7 6 mois sur
chaque face"
Range("N1").Select
ActiveCell.FormulaR1C1 = "Calendrier cartonné 13X17 6 mois su r
chaque face"
Range("O1").Select
ActiveCell.FormulaR1C1 = "Guilplan 16X16 AGENDA DE BUREAU"
Range("P1").Select
ActiveCell.FormulaR1C1 = "811859" & Chr(10) & "Guilplan 16X24
AGENDA DE BUREAU" & Chr(10) & "1.04"
Range("P1").Select
ActiveCell.FormulaR1C1 = "Guilplan 16X24 AGENDA DE BUREAU"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "Guilplan 21X27 AGENDA DE BUREAU"
Range("R1").Select
ActiveCell.FormulaR1C1 = "Guilplan 24X24 AGENDA DE BUREAU"
Range("W1").Select
'Comptage des lignes et envoi mail
Dim Nbligne As Long
Dim Outl As NewOutlook.Application
Dim Olmail As MailItem
Dim i
i = ActiveCell.Row
Nbligne = Range("A2").CurrentRegion.Rows.Count
'Version texte si M en colonne Y
For i = Nbligne To 2 Step 1
If Cells("Y", i).Value = "M" Then
Set Outl = NewOutlook.Application
Set Olmail = Outl.CreateItem(olMailItem)
With Olmail
.To = Range("C", i).Value
.Subject = "Votre Commande d'Agenda modifiée"
.Body = "Bonjour," & Chr(13) _
& Chr(13) _
& "Veuillez trouver ci-dessous, votre Commande d'Agenda e t de
Calendrier qui a été modifiée pour des raisons budgétaire, comme
suit :" & Chr(13) _
& Chr(13) _
& Range("G1").Value & " : " & Cells(i, "G").Value & Chr(1 3) _
& Range("H1").Value & " : " & Cells(i, "H").Value & Chr(1 3) _
& Range("I1").Value & " : " & Cells(i, "I").Value & Chr(1 3) _
& Range("J1").Value & " : " & Cells(i, "J").Value & Chr(1 3) _
& Range("K1").Value & " : " & Cells(i, "K").Value & Chr(1 3) _
& Range("L1").Value & " : " & Cells(i, "L").Value & Chr(1 3) _
& Range("M1").Value & " : " & Cells(i, "M").Value & Chr(1 3) _
& Range("N1").Value & " : " & Cells(i, "N").Value & Chr(1 3) _
& Range("O1").Value & " : " & Cells(i, "O").Value & Chr(1 3) _
& Range("P1").Value & " : " & Cells(i, "P").Value & Chr(1 3) _
& Range("Q1").Value & " : " & Cells(i, "Q").Value & Chr(1 3) _
& Range("R1").Value & " : " & Cells(i, "R").Value & Chr(1 3) _
& Range("S1").Value & " : " & Cells(i, "S").Value & Chr(1 3) _
& Range("T1").Value & " : " & Cells(i, "T").Value & Chr(1 3) _
& Range("U1").Value & " : " & Cells(i, "U").Value & Chr(1 3) _
& Range("V1").Value & " : " & Cells(i, "V").Value & Chr(1 3) _
& Range("W1").Value & " : " & Cells(i, "W").Value & Chr(1 3) _
& "================== ========================= ============" &
Chr(13) _
& "TOTAL ARTICLE(S)" & " : " & Cells(i, "X").Value & Chr( 13) _
& Chr(13) _
& "Cordialement," & Chr(13) & "Service Organisation Gesti on"
.Send
End With
'Version si pas de M en colonne Y
Else:
Set Outl = NewOutlook.Application
Set Olmail = Ol.CreateItem(olMailItem)
With Olmail
.To = Range("i,C").Value
.Subject = "Confirmation de votre Commande d'Agenda"
.Body = "Bonjour," & Chr(13) _
& Chr(13) _
& "Veuillez trouver ci-dessous, votre confirmation de Com mande
d'Agenda et de Calendrier pour l'année prochaine :" & Chr(13) _
& Chr(13) _
& Range("G1").Value & " : " & Cells(i, "G").Value & Chr(1 3) _
& Range("H1").Value & " : " & Cells(i, "H").Value & Chr(1 3) _
& Range("I1").Value & " : " & Cells(i, "I").Value & Chr(1 3) _
& Range("J1").Value & " : " & Cells(i, "J").Value & Chr(1 3) _
& Range("K1").Value & " : " & Cells(i, "K").Value & Chr(1 3) _
& Range("L1").Value & " : " & Cells(i, "L").Value & Chr(1 3) _
& Range("M1").Value & " : " & Cells(i, "M").Value & Chr(1 3) _
& Range("N1").Value & " : " & Cells(i, "N").Value & Chr(1 3) _
& Range("O1").Value & " : " & Cells(i, "O").Value & Chr(1 3) _
& Range("P1").Value & " : " & Cells(i, "P").Value & Chr(1 3) _
& Range("Q1").Value & " : " & Cells(i, "Q").Value & Chr(1 3) _
& Range("R1").Value & " : " & Cells(i, "R").Value & Chr(1 3) _
& Range("S1").Value & " : " & Cells(i, "S").Value & Chr(1 3) _
& Range("T1").Value & " : " & Cells(i, "T").Value & Chr(1 3) _
& Range("U1").Value & " : " & Cells(i, "U").Value & Chr(1 3) _
& Range("V1").Value & " : " & Cells(i, "V").Value & Chr(1 3) _
& Range("W1").Value & " : " & Cells(i, "W").Value & Chr(1 3) _
& "================== ========================= ============" &
Chr(13) _
& "TOTAL ARTICLE(S)" & " : " & Cells(i, "X").Value & Chr( 13) _
& Chr(13) _
& "Cordialement," & Chr(13) & "Service Organisation Gesti on"
.Send
End With
End If
Next i
End Sub
Mais voilà, aucunebouclene se fait et aucun mail part. J'ai tenté
sans condition, mais pas mieux - pas deboucle.
Merci par avance de votre aide.
Cordialement.
Alex
Re Bonjour à tous, (Astuce et solution... lol)
J'ai recherché et testé les différents conseils et solutions de mêm e
type, mais rien n'a faire ...ça passait toujours pas!!!. Alors j'ai
testé ma macro, mais cette fois ci, en idenquant que les cellules de
la ligne 2, 1ère ligne de reference des mails à envoyer. Et cela a
fonctionné tout de suite. J'ai alors procédé à un DO WHILE avec un
controle de la valeur de la cellule C2 (adresse mai)l <> "" et
ajouter après le .send une commande de suppression de la ligne 2....
Il faut bien entendu faire une copie de la feuille, sinon vous perdrez
toutes les données... C bête lol (<= Ca c'était le côté Astuce )
Maintenant la solution : (Ca parrait long, mais c'est surtout du
texte)
Sub ENVOI_MAIL_MULTIPLE()
Dim Ol As New Outlook.Application
Dim Message As MailItem
Dim Text As Object
Sheets("RECAP").Select
'Création doublon feuille
Sheets("RECAP").Copy Before:=Sheets(1)
Sheets("RECAP (2)").Activate
'Suppression Filtre
Range("A1:X1").Select
Application.CutCopyMode = False
Selection.AutoFilter
'ENVOI MAIL DANS DO WHILE LOOP
Sheets("RECAP (2)").Select
Do While Range("C2").Value <> ""
Set Ol = New Outlook.Application
Set Message = Ol.CreateItem(olMailItem)
With Message
.To = Range("C2").Value
.Subject = Range("Z2").Value
.Body = "Bonjour," & Chr(13) _
& Chr(13) & Range("Y2") & Chr(13) & Chr(13) _
& "Socle en bois - ""BLOC PRATIC"" sans recharge : " &
Range("G2").Value & Chr(13) _
& "Recharge ""BLOC PRATIC"" - Date à gauche : " & Range
("H2").Value & Chr(13) _
& "Agenda 22X14 - 1 jour à la page couverture cartonnée :
" & Range("I2") & Chr(13) _
& "Agenda 35X15 - 1 jour à la page couverture cartonnée :
" & Range("J2").Value & Chr(13) _
& "Calendrier bloc éphéméride 8X10 sur plaque : " & Range
("K2").Value & Chr(13) _
& "Planning vacances et absences Décembre à Décembre" &
Range("L2").Value & Chr(13) _
& "Calendrier cartonné 21X29,7 6 mois sur chaque face" &
Range("M2").Value & Chr(13) _
& "Calendrier cartonné 13X17 6 mois sur chaque face : " &
Range("N2").Value & Chr(13) _
& "Guilplan - 16X16 - AGENDA DE BUREAU : " & Range
("O2").Value & Chr(13) _
& "Guilplan - 16X24 - AGENDA DE BUREAU : " & Range
("P2").Value & Chr(13) _
& "Guilplan - 21X27 - AGENDA DE BUREAU : " & Range
("Q2").Value & Chr(13) _
& "Guilplan - 24X24 - AGENDA DE BUREAU : " & Range
("R2").Value & Chr(13) _
& "Semaine Poche Temporel 16 - 16X8 : " & Range
("S2").Value & Chr(13) _
& "Recharge EXATIME 14 - 2J/P - 12X8 : " & Range
("T2").Value & Chr(13) _
& "Recharge EXATIME 17 - 1S/2P - 17X10 ; " & Range
("U2").Value & Chr(13) _
& "Recharge Semainier - OBER ""UP TO DAT"" - 48660 : " &
Range("V2").Value & Chr(13) _
& "CALENDRIER SEMESTRIEL GMF - 36X43 : " & Range
("W2").Value & Chr(13) _
&
"======================== ========================= ======================"
& Chr(13) _
& "TOTAL ARTICLE(S) : " & Range("X2").Value & Chr(13) _
& Chr(13) _
& "Cordialement," & Chr(13) & "Service Organisation
Gestion"
.Send
End With
Rows("2:2").Select
Selection.Delete Shift:=xlUp
Range("C2").Select
Loop
Sheets("RECAP (2)").Select
ActiveWindow.SelectedSheets.Delete
End Sub
Voilà, j'espère que ca pourra être utile à quelqu'un, c'est ma fa çon
de remercié toutes les personnes qui ont pu m'aider, ou m'aiguiller
devant d'autres problèmes VBA.
Cordialement.
Alex
J'ai un problème sur unebouclepour communiquer avecoutlookdepuis Excel, avec une condition. Mon tableau est simple, Titres Colonnes : A = Nom B= Prénom C= Adresse Mail D à F = autres information concernant le Nom G à W = des References articles X = Total Articles Y= Commande modifiee pour raison bugétaire
Sur Chaque ligne, les infos correspondent aux titres des colonnes, et pour les colonnes de G à W = nombre d'article de la référence art icle et colonne Y = M si modifié, et vide si pas modifié.
Ma condition : si valeur "M" en colonne Y, alors envoi d'un mail avec message informant l'interessé qu'il y a eu modification de sa demande, si vide, confirmation de la commande. (Juste le corps du texte d'intro qui change)
Laboucle, pour qu'il me fasse un mail pour chacune des lignes et en fonction de la colonne Y, et j'ai écrit ceci :
Sub ConfirmationCommande()
Sheets("RECAP").Select 'Création doublon feuille Sheets("RECAP").Copy Before:=Sheets(1) Sheets("RECAP (2)").Activate 'Suppression Filtre Range("A1:X1").Select Application.CutCopyMode = False Selection.AutoFilter 'Remise en forme Texte et Titre Range("G1:X1").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("G1").Select ActiveCell.FormulaR1C1 = "Socle en bois - ""BLOC PRATIC"" sans recharge" Range("I1").Select ActiveCell.FormulaR1C1 = "Agenda 22X14 - 1 jour à la page couverture cartonnée" Range("H1").Select ActiveCell.FormulaR1C1 = "Recharge ""BLOC PRATIC"" - Date à gauche" Range("J1").Select ActiveCell.FormulaR1C1 = "Agenda 35X15 - 1 jour à la page couverture cartonnée" Range("K1").Select ActiveCell.FormulaR1C1 = "Calendrier bloc éphéméride 8X10 sur plaque" Range("L1").Select ActiveCell.FormulaR1C1 = "Planning vacances et absences Décem bre à Décembre" Range("M1").Select ActiveCell.FormulaR1C1 = "Calendrier cartonné 21X29,7 6 mois sur chaque face" Range("N1").Select ActiveCell.FormulaR1C1 = "Calendrier cartonné 13X17 6 mois su r chaque face" Range("O1").Select ActiveCell.FormulaR1C1 = "Guilplan 16X16 AGENDA DE BUREAU" Range("P1").Select ActiveCell.FormulaR1C1 = "811859" & Chr(10) & "Guilplan 16X24 AGENDA DE BUREAU" & Chr(10) & "1.04" Range("P1").Select ActiveCell.FormulaR1C1 = "Guilplan 16X24 AGENDA DE BUREAU" Range("Q1").Select ActiveCell.FormulaR1C1 = "Guilplan 21X27 AGENDA DE BUREAU" Range("R1").Select ActiveCell.FormulaR1C1 = "Guilplan 24X24 AGENDA DE BUREAU" Range("W1").Select 'Comptage des lignes et envoi mail Dim Nbligne As Long Dim Outl As NewOutlook.Application Dim Olmail As MailItem Dim i i = ActiveCell.Row Nbligne = Range("A2").CurrentRegion.Rows.Count 'Version texte si M en colonne Y For i = Nbligne To 2 Step 1 If Cells("Y", i).Value = "M" Then Set Outl = NewOutlook.Application Set Olmail = Outl.CreateItem(olMailItem) With Olmail .To = Range("C", i).Value .Subject = "Votre Commande d'Agenda modifiée" .Body = "Bonjour," & Chr(13) _ & Chr(13) _ & "Veuillez trouver ci-dessous, votre Commande d'Agenda e t de Calendrier qui a été modifiée pour des raisons budgétaire, comme suit :" & Chr(13) _ & Chr(13) _ & Range("G1").Value & " : " & Cells(i, "G").Value & Chr(1 3) _ & Range("H1").Value & " : " & Cells(i, "H").Value & Chr(1 3) _ & Range("I1").Value & " : " & Cells(i, "I").Value & Chr(1 3) _ & Range("J1").Value & " : " & Cells(i, "J").Value & Chr(1 3) _ & Range("K1").Value & " : " & Cells(i, "K").Value & Chr(1 3) _ & Range("L1").Value & " : " & Cells(i, "L").Value & Chr(1 3) _ & Range("M1").Value & " : " & Cells(i, "M").Value & Chr(1 3) _ & Range("N1").Value & " : " & Cells(i, "N").Value & Chr(1 3) _ & Range("O1").Value & " : " & Cells(i, "O").Value & Chr(1 3) _ & Range("P1").Value & " : " & Cells(i, "P").Value & Chr(1 3) _ & Range("Q1").Value & " : " & Cells(i, "Q").Value & Chr(1 3) _ & Range("R1").Value & " : " & Cells(i, "R").Value & Chr(1 3) _ & Range("S1").Value & " : " & Cells(i, "S").Value & Chr(1 3) _ & Range("T1").Value & " : " & Cells(i, "T").Value & Chr(1 3) _ & Range("U1").Value & " : " & Cells(i, "U").Value & Chr(1 3) _ & Range("V1").Value & " : " & Cells(i, "V").Value & Chr(1 3) _ & Range("W1").Value & " : " & Cells(i, "W").Value & Chr(1 3) _ & "================== ========================= ============" & Chr(13) _ & "TOTAL ARTICLE(S)" & " : " & Cells(i, "X").Value & Chr( 13) _ & Chr(13) _ & "Cordialement," & Chr(13) & "Service Organisation Gesti on" .Send End With 'Version si pas de M en colonne Y Else: Set Outl = NewOutlook.Application Set Olmail = Ol.CreateItem(olMailItem) With Olmail .To = Range("i,C").Value .Subject = "Confirmation de votre Commande d'Agenda" .Body = "Bonjour," & Chr(13) _ & Chr(13) _ & "Veuillez trouver ci-dessous, votre confirmation de Com mande d'Agenda et de Calendrier pour l'année prochaine :" & Chr(13) _ & Chr(13) _ & Range("G1").Value & " : " & Cells(i, "G").Value & Chr(1 3) _ & Range("H1").Value & " : " & Cells(i, "H").Value & Chr(1 3) _ & Range("I1").Value & " : " & Cells(i, "I").Value & Chr(1 3) _ & Range("J1").Value & " : " & Cells(i, "J").Value & Chr(1 3) _ & Range("K1").Value & " : " & Cells(i, "K").Value & Chr(1 3) _ & Range("L1").Value & " : " & Cells(i, "L").Value & Chr(1 3) _ & Range("M1").Value & " : " & Cells(i, "M").Value & Chr(1 3) _ & Range("N1").Value & " : " & Cells(i, "N").Value & Chr(1 3) _ & Range("O1").Value & " : " & Cells(i, "O").Value & Chr(1 3) _ & Range("P1").Value & " : " & Cells(i, "P").Value & Chr(1 3) _ & Range("Q1").Value & " : " & Cells(i, "Q").Value & Chr(1 3) _ & Range("R1").Value & " : " & Cells(i, "R").Value & Chr(1 3) _ & Range("S1").Value & " : " & Cells(i, "S").Value & Chr(1 3) _ & Range("T1").Value & " : " & Cells(i, "T").Value & Chr(1 3) _ & Range("U1").Value & " : " & Cells(i, "U").Value & Chr(1 3) _ & Range("V1").Value & " : " & Cells(i, "V").Value & Chr(1 3) _ & Range("W1").Value & " : " & Cells(i, "W").Value & Chr(1 3) _ & "================== ========================= ============" & Chr(13) _ & "TOTAL ARTICLE(S)" & " : " & Cells(i, "X").Value & Chr( 13) _ & Chr(13) _ & "Cordialement," & Chr(13) & "Service Organisation Gesti on" .Send End With End If Next i End Sub
Mais voilà, aucunebouclene se fait et aucun mail part. J'ai tenté sans condition, mais pas mieux - pas deboucle.
Merci par avance de votre aide. Cordialement. Alex
Re Bonjour à tous, (Astuce et solution... lol) J'ai recherché et testé les différents conseils et solutions de mêm e type, mais rien n'a faire ...ça passait toujours pas!!!. Alors j'ai testé ma macro, mais cette fois ci, en idenquant que les cellules de la ligne 2, 1ère ligne de reference des mails à envoyer. Et cela a fonctionné tout de suite. J'ai alors procédé à un DO WHILE avec un controle de la valeur de la cellule C2 (adresse mai)l <> "" et ajouter après le .send une commande de suppression de la ligne 2.... Il faut bien entendu faire une copie de la feuille, sinon vous perdrez toutes les données... C bête lol (<= Ca c'était le côté Astuce )
Maintenant la solution : (Ca parrait long, mais c'est surtout du texte)
Sub ENVOI_MAIL_MULTIPLE()
Dim Ol As New Outlook.Application Dim Message As MailItem Dim Text As Object
Sheets("RECAP").Select 'Création doublon feuille Sheets("RECAP").Copy Before:=Sheets(1) Sheets("RECAP (2)").Activate 'Suppression Filtre Range("A1:X1").Select Application.CutCopyMode = False Selection.AutoFilter 'ENVOI MAIL DANS DO WHILE LOOP Sheets("RECAP (2)").Select Do While Range("C2").Value <> "" Set Ol = New Outlook.Application Set Message = Ol.CreateItem(olMailItem) With Message .To = Range("C2").Value .Subject = Range("Z2").Value .Body = "Bonjour," & Chr(13) _ & Chr(13) & Range("Y2") & Chr(13) & Chr(13) _ & "Socle en bois - ""BLOC PRATIC"" sans recharge : " & Range("G2").Value & Chr(13) _ & "Recharge ""BLOC PRATIC"" - Date à gauche : " & Range ("H2").Value & Chr(13) _ & "Agenda 22X14 - 1 jour à la page couverture cartonnée : " & Range("I2") & Chr(13) _ & "Agenda 35X15 - 1 jour à la page couverture cartonnée : " & Range("J2").Value & Chr(13) _ & "Calendrier bloc éphéméride 8X10 sur plaque : " & Range ("K2").Value & Chr(13) _ & "Planning vacances et absences Décembre à Décembre" & Range("L2").Value & Chr(13) _ & "Calendrier cartonné 21X29,7 6 mois sur chaque face" & Range("M2").Value & Chr(13) _ & "Calendrier cartonné 13X17 6 mois sur chaque face : " & Range("N2").Value & Chr(13) _ & "Guilplan - 16X16 - AGENDA DE BUREAU : " & Range ("O2").Value & Chr(13) _ & "Guilplan - 16X24 - AGENDA DE BUREAU : " & Range ("P2").Value & Chr(13) _ & "Guilplan - 21X27 - AGENDA DE BUREAU : " & Range ("Q2").Value & Chr(13) _ & "Guilplan - 24X24 - AGENDA DE BUREAU : " & Range ("R2").Value & Chr(13) _ & "Semaine Poche Temporel 16 - 16X8 : " & Range ("S2").Value & Chr(13) _ & "Recharge EXATIME 14 - 2J/P - 12X8 : " & Range ("T2").Value & Chr(13) _ & "Recharge EXATIME 17 - 1S/2P - 17X10 ; " & Range ("U2").Value & Chr(13) _ & "Recharge Semainier - OBER ""UP TO DAT"" - 48660 : " & Range("V2").Value & Chr(13) _ & "CALENDRIER SEMESTRIEL GMF - 36X43 : " & Range ("W2").Value & Chr(13) _ & "======================== ========================= ======================" & Chr(13) _ & "TOTAL ARTICLE(S) : " & Range("X2").Value & Chr(13) _ & Chr(13) _ & "Cordialement," & Chr(13) & "Service Organisation Gestion" .Send End With Rows("2:2").Select Selection.Delete Shift:=xlUp Range("C2").Select
Loop
Sheets("RECAP (2)").Select ActiveWindow.SelectedSheets.Delete End Sub
Voilà, j'espère que ca pourra être utile à quelqu'un, c'est ma fa çon de remercié toutes les personnes qui ont pu m'aider, ou m'aiguiller devant d'autres problèmes VBA. Cordialement. Alex
