Macro VBA cellules actives + onglet actif en PJ
Bonjour,
Je souhaite, à partir d'un document excel envoyer un mail a chaque email présente dans la colonne "b", avec le texte qui va avec, dans la colonne C:
B C
Pierre Bonjour Pierre
Paul Bonjour Paul
Jaques Bonjour Jaques
1 er email :
TO: Pierre
Body : Bonjour Pierre
2e email:
TO: Paul
Body: Bonjour Paul
La deuxième partie de la macro, doit ajouter l'onglet de travail excel sur lequel je travaille (uniquement).
J'ai trouvé un code pour cette partie, qui marche parfaitement, mais je ne trouve pas le moyen d'intégrer la premiere partie de ma demande (inserer les cellules dans l'email crée).
Pourriez vous m'aider SVPPPP.
Voici le code pour copier l'onglet actif dans l'email:
Sub Mail_ActiveSheet()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
' Next, copy the sheet to a new workbook.
' You can also use the following line, instead of using the ActiveSheet object,
' if you know the name of the sheet you want to mail :
' Sheets("Sheet5").Copy
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
' Determine the Excel version, and file extension and format.
With Destwb
If Val(Application.Version) < 12 Then
' For Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
' For Excel 2007-2010, exit the subroutine if you answer
' NO in the security dialog that is displayed when you copy
' a sheet from an .xlsm file with macros disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "You answered NO in the security dialog."
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With
' You can use the following statements to change all cells in the
' worksheet to values.
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False
' Save the new workbook, mail, and then delete it.
TempFilePath = Environ$("temp") & "\"
TempFileName = " " & Sourcewb.Name & " " _
& Format(Now, "dd-mmm-yy")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
' Change the mail address and subject in the macro before
' running the procedure.
With OutMail
.To = "grandac@airproducts.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hello World!"
.Attachments.Add Destwb.FullName
' You can add other files by uncommenting the following statement.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
' Delete the file after sending.
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Bonjour,
C'est parfait, c'est ce que je voulais mais ... aurais tu une solution pour que le nombre de destinataires ne soit pas prédéfini ?
Il y a des mois ou je vais avoir 10 destinataires, mais le mois d'après 5 , puis 50 , puis 9 ...
le top serait de mettre une "condition" : envoyer des mails que quand la cellule est pleine ..
Saurais tu faire ca ?
Merci beaucoup pour ton aide!!!
Bonjour,
je te prépare ça.
Re bonjour,
version jusqu'à 100 destinataires max,
sinon faire évoluer cette ligne de code
For a = 1 To Range("B100").End(xlUp).Row 'Destinataires de 1 à 100
C'est parfait merci, mais dernier problème, je n'arrive pas a choisir les bonnes colonnes pour lancer ma macro : dans l'exemple, j'ai dit les colonnes B et C , alors que dans mon document c'est C pour le destinataire et le body sera dans une autre colonne ..
J'ai changé les lettres dans la macro mais ça ne change pas
Pour l'adresse en colonne C, tu changes cette partie du code :
For a = 1 To Range("C100").End(xlUp).Row 'Destinataires de 1 à 100
Range("C" & a).Select
If Not IsEmpty(Range("C" & a)) = True Then Call mail
Next a
Pour le .Body, il faut adapter cette ligne :
.body = ActiveCell.Offset(0, 1)
- le 0 signifie qu'on est sur la même ligne
- la valeur 1 correspond à un décalage de 1 vers la droite par rapport à la cellule où est l'adresse mail
ca marche très mal, je ne comprends pas !!!
J'ai modifié ton code comme tu l'as dit, mais maintenant tout dépend de la cellule selectionnée par la souris ..... !!!!!! je n'obtiens plus le bon résultat, plus de boucle, plus rien ...
Je t'envoie mon fichier, si tu peux trouver la solution directement dessus ca serait top !
Il faut envoyer a "C", le body "T" :
TO: Pierre
Body: BONJOUR PIERRE
La macro pour lancer la procédure de mail est cell_pleine
En pièce jointe la macro adaptée à tes besoins.