envoie copie fichier par mail

drisou · 11 Février 2010

bonsoir le Forum,
voila j'utilise le code suivant pour envoyer par mail , le fichier actif, mais le fichier contient plusieurs feuille , avec des formules et des macro ,du coup le fichier deviens lourd et surtout les expéditeurs n'ont besoin que de la "feuille1" ,sans les macros que le fichier contient.

je voulais savoir si en reprenant la macro suivante , il était possible d'envoyer le fichier actif mais uniquement la "feuille1", ce qui ferait que le fichier soit leger pour l'envoie par mail.

Sub envoiemail(ByVal control As IRibbonControl)

ActiveWorkbook.SendMail ("leric@wa.fr")
ActiveWorkbook.SendMail ("pascal@coco.com")

End Sub

Merci pour votre aide.

drisou · 12 Février 2010

Re : envoie copie fichier par mail

re bonsoir le forum,
je sollicite votre aide,

j'ai trouver une macro qui correspond exactement ce que je cherche, mais le petit soucis est que j'ai un message lors de l'exécution de la commande qui me dit "les projets vb ne peuvent pas être enregistrer dans des classeurs sans macro, pour enregistrer le classeur sans macro cliquer oui".

j'aimerais donc passer outre ce message ,car je souhaite l'enregistrer sans macro
et donc éviter a chaque de devoir avoir ce message et confirmer.

macro :

Sub envoiemail(ByVal control As IRibbonControl)

Worksheets("feuil1").Copy

With ActiveWorkbook

.SaveAs Filename:=("journée du ") & Format(Now(), "ddmmyy") & ".xls"

ActiveWorkbook.SendMail ("leric@wa.fr")
ActiveWorkbook.SendMail ("pascal@coco.com")

ActiveWorkbook.Close
End With
End Sub

Merci pour votre aide.

Roland_M · 12 Février 2010

Re : envoie copie fichier par mail

bonjour

rajouter le FileFormat ?!

ceci en xls mode compatibité 97-2003

Code:

Sub EnvoiEmail() ' en xls
Worksheets("feuil1").Copy
Fich$ = "journée du " & Format(Now(), "ddmmyy") & ".xls"
With ActiveWorkbook
 .SaveAs Filename:=Fich$, FileFormat:=xlWorkbookNormal
 ActiveWorkbook.SendMail ("leric@wa.fr")
 ActiveWorkbook.SendMail ("pascal@coco.com")
 ActiveWorkbook.Close
End With
End Sub

ceci en xlsm 2007 avec macro

Code:

Sub EnvoiEmail2() ' en xlsm
Worksheets("feuil1").Copy
Fich$ = "journée du " & Format(Now(), "ddmmyy") & ".xlsm"
With ActiveWorkbook
 .SaveAs Filename:=Fich$, FileFormat:=xlOpenXMLWorkbookMacroEnabled
 ActiveWorkbook.SendMail ("leric@wa.fr")
 ActiveWorkbook.SendMail ("pascal@coco.com")
 ActiveWorkbook.Close
End With
End Sub

drisou · 12 Février 2010

Re : envoie copie fichier par mail

bonsoir Roland_M , le forum
merci Roland d'avoir répondu,
ton code marche bien , mais le soucis est que la feuille copié et envoyé par mail est du meme poids que que le fichier source c'est a dire 4mo.
et avec le code que j'ai mis ci dessus , la feuille envoyé est de 1,40mo.

peut être aurais tu une solution pour que avec ton code je puisse copier la feuille avec les données qu'elle contient ,en tant que valeur ,et envoyer la feuille sans les macros et formule qui sont contenu dans le fichier source .

ma pièce jointe même zippé fait 650ko.

Merci encore.

Roland_M · 13 Février 2010

Re : envoie copie fichier par mail

re:

Code:

Sub EnvoiEmail()
'select source et copy toutes les cellules de cette feuille
Worksheets("feuil1").Select
With ActiveSheet.UsedRange
 NoDeLaDernLig = .Cells(.Rows.Count, .Columns.Count).Row
 NoDeLaDernCol = .Cells(.Rows.Count, .Columns.Count).Column
End With
ActiveSheet.Range(Cells(1, 1), Cells(NoDeLaDernLig, NoDeLaDernCol)).Copy

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

'save - envoie - close
Fich$ = "journée du " & Format(Now(), "ddmmyy") & ".xls"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Fich$, FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True
ActiveWorkbook.SendMail ("leric@wa.fr")
ActiveWorkbook.SendMail ("pascal@coco.com")
ActiveWorkbook.Close
End Sub

drisou · 13 Février 2010

Re : envoie copie fichier par mail

Bonjour Roland_M, le forum,
Merci roland_M , ca marche super bien,
j'ai par contre oublié demander une petite chose, c'est si possible ,au lieu d'avoir comme nom de fichier:
Fich$ = "journée du " & Format(Now(), "ddmmyy") & ".xls"

ca serai d'avoir :
Fich$ = "journée du " & Format(Now(), " ici la valeur de ma cellule A3" au lieu de la date" & ".xls"
car il se peut que le fichier de la veille soit envoyé le lendemain, donc la date du nom de ficheir ne correspondrait plus.
Merci et désolé pour ces demandes.

Roland_M · 13 Février 2010

Re : envoie copie fichier par mail

re:

ENVOI AVEC SAUVEGARDE DU FICHIER SUR LE DISQUE

Code:

Sub EnvoiEmail()
'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
Set NewBook = Workbooks.Add
NewBook.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
NewBook.Sheets(1).Range("A1").Select
Application.CutCopyMode = False

'save - envoie - close
Application.DisplayAlerts = False
NewBook.SaveAs Filename:=Fich$, FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True
NewBook.SendMail ("leric@wa.fr")
NewBook.SendMail ("pascal@coco.com")
NewBook.Close
End Sub

ENVOI SANS SAUVEGARDE DU FICHIER SUR LE DISQUE

Code:

Sub EnvoiEmail()
'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
Set NewBook = Workbooks.Add
NewBook.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
NewBook.Sheets(1).Range("A1").Select
Application.CutCopyMode = False

'envoie et close
NewBook.SendMail ("leric@wa.fr")
NewBook.SendMail ("pascal@coco.com")
NewBook.Close False
End Sub

Roland_M · 13 Février 2010

Re : envoie copie fichier par mail

re

voir avec copie des formats !
les deux Subs avec et sans save fich

Code:

Sub EnvoiEmailAVECsaveFich()
'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
Application.CutCopyMode = False: 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 - envoie - close
Application.DisplayAlerts = False
NewBook.SaveAs Filename:=Fich$, FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True
NewBook.SendMail ("leric@wa.fr")
NewBook.SendMail ("pascal@coco.com")
NewBook.Close
End Sub



Sub EnvoiEmailSANSsaveFich()
'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

'envoie et close
NewBook.SendMail ("leric@wa.fr")
NewBook.SendMail ("pascal@coco.com")
NewBook.Close False
End Sub

drisou · 13 Février 2010

Re : envoie copie fichier par mail

Merci Roland_M,
le code sans sauvegarde sur Disk m'intéresse beaucoup plus, le souci est que le fichier envoyé porte le nom" classeur 2" au lieu de "journée du" + la valeur de la cellule "A3".

Merci beaucoup.

Roland_M · 13 Février 2010

Re : envoie copie fichier par mail

re

j'y regarde et je te dis quoi !

Roland_M · 13 Février 2010

Re : envoie copie fichier par mail

re

cette macro cré le fichier et le copi pour le nommer
puis envoi et ensuite close et supprime du disque !

Code:

Sub EnvoiEmail()
'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
ActiveWorkbook.SendMail ("leric@wa.fr")
ActiveWorkbook.SendMail ("pascal@coco.com")
'close et supprime le fichier du disque
ActiveWorkbook.Close False
Kill FichTemp$
End Sub

drisou · 13 Février 2010

Re : envoie copie fichier par mail

re, Merci Roland_M, ca marche bien comme ca,

y'a quand même un petit truc que je comprends pas , c'est pourquoi le nouveau fichier créer et envoyé par mail via la macro pèse 2 mo, alors que lorsque je créer un nouveau classeur manuellement et que j'y colle manuellement les données du fichier source, le fichier pèse que 150 ko.

Roland_M · 13 Février 2010

Re : envoie copie fichier par mail

effectivement c'est bizarre !
mais je sais pas ce que contient ton fichier !
essai en mettant une rem (le signe ' ) devant ceci

'Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,

EDIT voir aussi ...
après ceci
Selection.FormatConditions.Delete

rajoute
Selection.Hyperlinks.Delete

c'est pour supprimer les liens si toutefois il en a et s'ils seront inutile !?

manuBX · 13 Février 2010

Re : envoie copie fichier par mail

Bonjour
je suis novice et interessé par cette macro
j ai essayé de la faire fonctionner mais il se met en défaut " variables non defini"
pouvez vous m éclairer et m aider
Merci d avance
A+

Roland_M · 13 Février 2010

Re : envoie copie fichier par mail

bonsoir manu

tout dépend ou cela se produit !?
tu te places sur la macro et tu fais F8 pour exécuter le code pas à pas
et tu verras sur quelle ligne ça bloque !

mais il est fort probable que ça vienne de NewBook non déclaré !?
pour ce faire :
juste avant > Set NewBook = Workbooks.Add
tu mets ceci > Dim NewBook As Workbook

soit :
Dim NewBook As Workbook
Set NewBook = Workbooks.Add

EDIT
il est possible aussi que tu ai au début de ton module ceci
Option Explicit

dans ce cas essais sans Option Explicit
sinon il faut déclarer toutes les variables qui sont dans la macro

envoie copie fichier par mail

drisou

XLDnaute Occasionnel

drisou

XLDnaute Occasionnel

Roland_M

XLDnaute Barbatruc

drisou

XLDnaute Occasionnel

Roland_M

XLDnaute Barbatruc

drisou

XLDnaute Occasionnel

Roland_M

XLDnaute Barbatruc

Roland_M

XLDnaute Barbatruc

drisou

XLDnaute Occasionnel

Roland_M

XLDnaute Barbatruc

Roland_M

XLDnaute Barbatruc

drisou

XLDnaute Occasionnel

Roland_M

XLDnaute Barbatruc

manuBX

XLDnaute Occasionnel

Roland_M

XLDnaute Barbatruc

Discussions similaires

envoie copie fichier par mail

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency