Modif macro envoi par mail

[manuBX]

Bonjour
Merci à ROLAND M pour cette macro qui fonctionne à merveille mais comment la modifier pour qu elle prenne en f1 et f2 l adresse mail plutot que l avoir dans la macro
VOIR CI JOINT partie en couleur
merci d avance
CORDIALEMENT
A+

Sub EnvoiEmail()
Dim NewBook As Workbook, Fich As String, FichTemp As String

'select source et init nom du fich avec date en [A3]
Worksheets("feuil1").Select: Worksheets("feuil1").Activate
Fich = "journée du " & Format(ActiveSheet.Range("A3"), "ddmmyy") & ".xls"

'copy toutes les cellules occupées de cette feuille
ActiveSheet.UsedRange.Copy

'cré NewBook et colle les valeurs avec formats
Set NewBook = Workbooks.Add
NewBook.Sheets(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.FormatConditions.Delete
Application.CutCopyMode = False
NewBook.Sheets(1).Range("A1").Select

'save et load le chemin complet pour suppr après
Application.DisplayAlerts = False
NewBook.SaveAs Filename:=Fich, FileFormat:=xlWorkbookNormal
FichTemp = ActiveWorkbook.FullName
Application.DisplayAlerts = True
'envoi secteur certainement a modifier
ActiveWorkbook.SendMail ("m.m@wanadoo.fr")
ActiveWorkbook.SendMail ("ml.mo@noe.fr ")
'close et supprime le fichier du disque
ActiveWorkbook.Close False
Kill FichTemp
End Sub

 

[Pierrot93]

Re : Modif macro envoi par mail

Bonjour,

essaye peut être ainsi :

ActiveWorkbook.SendMail Range("F1").Value

bonne journée
@+

 

[manuBX]

Re : Modif macro envoi par mail

Merci
c est tout a fait çà
A+

 

[Roland_M]

Re : Modif macro envoi par mail

bonjour à tous

ci-dessous la macro modifiée pour simplifier les adaptations !
voir les remarques et suivre les instructions.
il reste que le nom du fichier est nommé comme vous l'avez souhaité
mais cela peut être facilement adapté !

En fait la macro travaille avec des noms définit . . .
Une feuille nommée Donnees (qui contient les données à envoyer)
Une feulle nommée ParamEmail (qui contient les paramètres d'envoi)
Et toutes les cellules contenant les paramètres Email devront être nommées !!!

'Séparer les paramètres messagerie et les données à envoyer dans deux feuilles différentes !
'la macro tourne avec les noms ci-dessous :
'------------------------------------------
'1' Nommer la  feuille  avec les données à envoyer     "Donnees"
'2' Nommer la  feuille  avec les paramètres messagerie "ParamEmail"
'3' Nommer les Cellules avec les paramètres messagerie comme suit :
'la date  > CellDate . . . pour le nom du fichier (vous pouvez changer ceci dans le code !?)
'le sujet > CellSujet . . . le sujet du message
'adresses > CellAdresDestin . . . si plusieurs adresses séparer par ; (si marche pas essayer avec ,)

Sub EnvoiEmail()
Dim NewBook As Workbook, Fich$, FichTemp$, Sujet$, AdresDestin$

'select feuille avec paramètres Email et init var messagerie
Sheets("ParamEmail").Select

'nom du fich qui sera celui de la date placée en [CellAdate] EXP: "Journée du 01012010.xls"
Fich = "Journée du " & Format(Range("CellDate"), "ddmmyy") & ".xls"
Sujet = Range("CellSujet")
AdresDestin = Range("CellAdresDestin")

'select feuille avec données à envoyer et copy toutes les cellules occupées dans cette feuille
Sheets("Donnees").Select: Sheets("Donnees").Activate
ActiveSheet.UsedRange.Copy

'cré NewBook et COLLE LES VALEURS SEULEMENT avec formats
Set NewBook = Workbooks.Add
NewBook.Sheets(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.FormatConditions.Delete
Selection.Hyperlinks.Delete
Application.CutCopyMode = False
NewBook.Sheets(1).Range("A1").Select

'save et load le chemin complet pour suppr après
Application.DisplayAlerts = False
NewBook.SaveAs Filename:=Fich, FileFormat:=xlWorkbookNormal
FichTemp = ActiveWorkbook.FullName
Application.DisplayAlerts = True
'envoi
ActiveWorkbook.SendMail Recipients:=AdresDestin, Subject:=Sujet, ReturnReceipt:=True
'close et supprime le fichier du disque
ActiveWorkbook.Close False
Kill FichTemp

'fin retour feuille param
Sheets("ParamEmail").Select: Range("A1").Select
End Sub

je n'ai pas essayé ! si problème ne pas hésiter à revenir !

EDIT voir exemple ci-joint