Envoi d'une selection de cellules par mail

Fermé

maya - 18 oct. 2012 à 09:39
fabidou49 Messages postés 1 Date d'inscription dimanche 24 mars 2013 Statut Membre Dernière intervention 24 mars 2013 - 24 mars 2013 à 14:52

Bonjour,

J'ai sous Excel 2010 une feuille de calcul avec des colonnes de « A » à « BC » et des lignes de « 1 » à « 100 », je voudrais envoyer par mail uniquement la sélection suivante : $A$3 :$AA$55.
si j'utilise l'option définir zone d'impression et que j'envoie le fichier par mail, le destinataire reçoit la totalité de la feuille au lieu de la sélection.
Je suis novice en VBA quelqu'un aurait-il un code pour faire cela à partir d'un bouton ?
Merci d'avance

A voir également:

Envoyer plage de cellules par mail vba
Yahoo mail - Accueil - Mail
Formule excel pour additionner plusieurs cellules - Guide
Publipostage mail - Accueil - Word
Mail sos carte - Forum Vos droits sur internet
Gmail envoyer un mail - Guide

27 réponses

Réponse 21 / 27

Mike-31 Messages postés 18349 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 27 novembre 2024 5 105
22 oct. 2012 à 11:27

Re,

que veux tu dire par mise en page, la largeur des colonnes
la hauteur de ligne
la colorisation de certaines cellules ou de police

Réponse 22 / 27

maya
22 oct. 2012 à 11:58

re
je veux dire par là: il garde tout sauf les largeurs de colonnes
@+ merci

Réponse 23 / 27

Mike-31 Messages postés 18349 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 27 novembre 2024 5 105
22 oct. 2012 à 15:34

Re,

colle ce code à la place de l'autre, n'oublie pas de renseigner les contantes
Const Dest As Variant
Const Exped As Variant
Const C_Ent As Variant
et celle ci si la plage à copier à changer
Const Plage As Variant

Sub Envoi_Mail ()

Dim cdoBasic
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb, Destwb As Workbook
Dim TempFilePath, TempFileName As String
Dim Wb, iMsg, iConf As Object
Dim Flds As Variant
'--------------------------- Constante à renseigner
Const Feuille As Variant = "FORMULAIRE" '------------- nom de la feuille à cpier
Const Plage As Variant = "A1:H10" '------------------- plage à copier, (Cells.Copy toute la feuille)
Const Dest As Variant = "wwwwwwwwwww@free.fr" '- adresse mail du destinataire
Const Exped As Variant = "www.xxxxxxx@free.fr" '------ adresse mail de réponse de l'expéditeur
Const C_Ent As Variant = "SMTP.free.fr" '------------- adresse du SMTP (courrier entrant)
Const CC As Variant = "" '---------------------------- adresse mail CC
Const BCC As Variant = "" '--------------------------- adresse mail destinataire pour envoi BCC ou BCI ou CCI
Const NumPort As Variant = 25 '----------------------- n° port du serveur sortant
Const Nom_envoi As Variant = "Sourcewb.Name" '----------- nom identique du fichier expédié ou remplacer par "Nom souhaité"
'--------------------------- Si la connexion nécessite une authentification
Const N_Messag As Variant = "False" '----------------- Nom utilisateur messagerie, sinon mettre en "False"
Const Pass As Variant = "False" '--------------------- motdepasse sinon mettre en Fase
'--------------------------- Connexion en SSL comme gmail et hotmail etc... mettre la constante en "True" sinon "False"
Const Typ_Conex As Variant = "False"

'--------------------------- Début de procédure
On Error GoTo errorHandler
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
Set Destwb = Workbooks.Add
'-- Si la plage à copier contient des liaisons isoler la première ligne et libérer les lignes au dessous
Sourcewb.Sheets(Feuille).Range(Plage).Copy
Destwb.ActiveSheet.[A1].PasteSpecial Paste:=xlPasteFormats '---- copie les format
Destwb.ActiveSheet.[A1].PasteSpecial Paste:=xlPasteValues '----- copie les valeurs
Destwb.ActiveSheet.[A1].Select
'--------------------------- Déterminer la version d'Excel et d'extension du fichier utilisé
With Destwb
If Val(Application.Version) < 12 Then
'--------------------------- Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'--------------------------- Excel 2007-2010
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Votre réponse est NON dans la boîte de dialogue de sécurité"
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
TempFilePath = Environ$("temp") & "\"
'-------------------------- Nom du classeur expédié avec jour et heure d'envoi
TempFileName = Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
.Close savechanges:=False
End With
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = C_Ent '-------------- Saisir le SMTP du serveur sortant ex."smtp.free.fr"
.Item("http://schemas.microsoft.com/cdo/configuration/senduserreplyemailaddress") = Exped 'adresse email de réponse expéditeur
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = NumPort '-------- n° port du serveur sortant
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = Typ_Conex '---------- Connexion particulière
'--------------------------- Si la connexion nécessite une authentification libérer les 3 lignes
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
'ou
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = N_Messag ' Nom utilisateur messagerie sinon False
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Pass ' motdepasse sinon False
.Update
End With
With iMsg
Set .Configuration = iConf
.To = Dest
.CC = CC
.BCC = BCC
.From = Exped
.Subject = [C1].Value
.TextBody = "Bonjour" & " " & [C2].Value & "," & vbCrLf & vbCrLf _
& "Veuillez trouvez ci-joint le " & [C3].Value & "." & vbCrLf & vbCrLf _
& [C4].Value & vbCrLf _
& [C5].Value & vbCrLf _
& [C6].Value & vbCrLf _
& [C7].Value & vbCrLf _
& [C8].Value & vbCrLf _
& [C9].Value & vbCrLf _
& [C10].Value & vbCrLf & vbCrLf _
& [C11]
.AddAttachment TempFilePath & TempFileName & FileExtStr
.Send
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Le mail a été bien envoyé !" '------------- Facultatif, confirmation de l'envoi
Exit Sub
'--------------------------- Si erreur on sort de la procédure
errorHandler:
'--------------------------- Description de l'erreur survenue
MsgBox Err.Description
'--------------------------- Si erreur ferme la copie temporaire
For Each Wb In Workbooks
If Left(Wb.Name, 1) <> "Claseur" And Wb.Name <> ThisWorkbook.Name Then
Wb.Close
End If
Next Wb
End Sub

eriiic Messages postés 24601 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 25 novembre 2024 7 242
Modifié par eriiic le 22/10/2012 à 15:41

Bonjour à tous,

j'ai lu en diagonale mais il ne manquerait pas un .PasteSpecial Paste:=xlPasteColumnWidths pour répondre à la demande ?

eric

Mike-31 Messages postés 18349 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 27 novembre 2024 5 105
22 oct. 2012 à 16:47

Salut,

dans la demande, il doit "garder tout sauf les largeurs de colonnes"

je ne sais pas, à suivre

A+
Mike-31

Réponse 24 / 27

maya
22 oct. 2012 à 18:01

Re
J'ai fait un essai, j'ai un message qui me dit impossible de coller des cellules fusionnées de différentes tailles.
Au départ j'ai des colonnes de a à AA de largeur de colonne de 3 à 4, quand je reçois le fichier coller par mail, et que je l'ouvre j'ai des colonnes de largeur de 10.38
J'ai mis le fichier exemple en ligne, se sera peut-être plus simple et mieux que mes explications :
http://cjoint.com/12oc/BJwrFPNiCOb.htm
@+

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 25 / 27

maya
22 oct. 2012 à 18:10

re
petite precision le fichier définitif sera protegé, celà peut il avoir une incidence?

Réponse 26 / 27

Mike-31 Messages postés 18349 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 27 novembre 2024 5 105
23 oct. 2012 à 08:38

Colle simplement ce code à la place de l'autre, renseigne les constantes

Const Dest As Variant = "wwwwwwwwww@free.fr"
Const Exped As Variant = "www.xxxxxxx@free.fr"
Const C_Ent As Variant = "SMTP.free.fr"

Si ça bloque il faudra regarder dans ta messagerie le N° du port sortant mais je te dirais plus tard, normalement c'est bien le 25

Option Explicit

Sub Envoi_Mail()

Dim cdoBasic
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb, Destwb As Workbook
Dim TempFilePath, TempFileName As String
Dim Wb, iMsg, iConf As Object
Dim Flds As Variant
'--------------------------- Constante à renseigner
Const Feuille As Variant = "FORMULAIRE" '------------- nom de la feuille à cpier
Const Plage As Variant = "Cells" '------------------- plage à copier, (Cells.Copie toute la feuille)
Const Dest As Variant = "wwwwwwwwww@free.fr" '- adresse mail du destinataire
Const Exped As Variant = "www.xxxxxxx@free.fr" '------ adresse mail de réponse de l'expéditeur
Const C_Ent As Variant = "SMTP.free.fr" '------------- adresse du SMTP (courrier entrant)
Const CC As Variant = "" '---------------------------- adresse mail CC
Const BCC As Variant = "" '--------------------------- adresse mail destinataire pour envoi BCC ou BCI ou CCI
Const NumPort As Variant = 25 '----------------------- n° port du serveur sortant
Const Nom_envoi As Variant = "Sourcewb.Name" '----------- nom identique du fichier expédié ou remplacer par "Nom souhaité"
'--------------------------- Si la connexion nécessite une authentification
Const N_Messag As Variant = "False" '----------------- Nom utilisateur messagerie, sinon mettre en "False"
Const Pass As Variant = "False" '--------------------- motdepasse sinon mettre en Fase
'--------------------------- Connexion en SSL comme gmail et hotmail etc... mettre la constante en "True" sinon "False"
Const Typ_Conex As Variant = "False"

'--------------------------- Début de procédure
On Error GoTo errorHandler
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
Set Destwb = Workbooks.Add
'-- Si la plage à copier contient des liaisons isoler la première ligne et libérer les lignes au dessous
Sourcewb.Sheets(Feuille).Cells.Copy Destwb.ActiveSheet.[A1]
' Sourcewb.Sheets(Feuille).Range(Plage).Copy Destwb.ActiveSheet.[A1]
' Sourcewb.Sheets(Feuille).Range(Plage).Copy
' Destwb.ActiveSheet.[A1].PasteSpecial Paste:=xlPasteFormats '---- copie les format
' Destwb.ActiveSheet.[A1].PasteSpecial Paste:=xlPasteValues '----- copie les valeurs
' Destwb.ActiveSheet.[A1].PasteSpecial Paste:=xlPasteColumnWidths '---- copie les formats colonnes
' Destwb.ActiveSheet.[A1].Select
'--------------------------- Déterminer la version d'Excel et d'extension du fichier utilisé
With Destwb
If Val(Application.Version) < 12 Then
'--------------------------- Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'--------------------------- Excel 2007-2010
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Votre réponse est NON dans la boîte de dialogue de sécurité"
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
TempFilePath = Environ$("temp") & "\"
'-------------------------- Nom du classeur expédié avec jour et heure d'envoi
TempFileName = Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
.Close savechanges:=False
End With
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = C_Ent '-------------- Saisir le SMTP du serveur sortant ex."smtp.free.fr"
.Item("http://schemas.microsoft.com/cdo/configuration/senduserreplyemailaddress") = Exped 'adresse email de réponse expéditeur
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = NumPort '-------- n° port du serveur sortant
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = Typ_Conex '---------- Connexion particulière
'--------------------------- Si la connexion nécessite une authentification libérer les 3 lignes
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
'ou
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = N_Messag ' Nom utilisateur messagerie sinon False
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Pass ' motdepasse sinon False
.Update
End With
With iMsg
Set .Configuration = iConf
.To = Dest
.CC = CC
.BCC = BCC
.From = Exped
.Subject = [C1].Value
.TextBody = "Bonjour" & " " & [C2].Value & "," & vbCrLf & vbCrLf _
& "Veuillez trouvez ci-joint le " & [C3].Value & "." & vbCrLf & vbCrLf _
& [C4].Value & vbCrLf _
& [C5].Value & vbCrLf _
& [C6].Value & vbCrLf _
& [C7].Value & vbCrLf _
& [C8].Value & vbCrLf _
& [C9].Value & vbCrLf _
& [C10].Value & vbCrLf & vbCrLf _
& [C11]
.AddAttachment TempFilePath & TempFileName & FileExtStr
.Send
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Le mail a été bien envoyé !" '------------- Facultatif, confirmation de l'envoi
Exit Sub
'--------------------------- Si erreur on sort de la procédure
errorHandler:
'--------------------------- Description de l'erreur survenue
MsgBox Err.Description
'--------------------------- Si erreur ferme la copie temporaire
For Each Wb In Workbooks
If Left(Wb.Name, 1) <> "Claseur" And Wb.Name <> ThisWorkbook.Name Then
Wb.Close
End If
Next Wb
End Sub

eriiic Messages postés 24601 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 25 novembre 2024 7 242
23 oct. 2012 à 10:04

Salut mike,

tu cherches toujours à fermer tous les fichiers commençant par "claseur" (avec 1 seul s).
Hors il ne faudrait fermer que celui créé (s'il l'a été) : TempFileName & FileExtStr

eric

Réponse 27 / 27

fabidou49 Messages postés 1 Date d'inscription dimanche 24 mars 2013 Statut Membre Dernière intervention 24 mars 2013
24 mars 2013 à 14:52

Tout d'abord merci aux personnes qui ont expliqués, fournie cette macro.

Chez moi elle fonctionne tres bien, mais je voudrais au lieu d'envoyer le classeur au format .xls, l'envoyer en format PDF. J'ai essayé de remplacer le .xls par .pdf, mais la personne qui reçois le document ne peut l'ouvrir. Je voudrais donc savoir comment procéder.

De plus, je voudrais aussi enregistrer la feuille envoyée (toujours en pdf), dans dossier "c: ....." pour garder une trace de mon envoi.

Dernière demande, et désolé d'être aussi exigent, la feuille que je fais est une quittance de loyer. J'arrive a mettre la date d'envoi en automatique, par contre je voudrais pouvoir ecrire ceci, dans une ou plusieurs cellule de façon automatique comme la date, exemple: période du xxx au xxx. les "xxx" seront remplacés par la période que couvre la quittance, soit du 01 mars 2013 au 31 mars 2013. Il faut donc gérer si le mois est a 30 jour ou 31 ou 28 pour février.

Je vous remercie par avance pour vos lumières.

Discussions similaires

Macro VBA qui effacer une plage de cellule

copier une plage de cellule ( range) sur un autre fichier excel

Copier plage cellules d'un classeur vers un autre classeur

AutoFill jusqu'à la dernière cellule non vide

copier une plage de cellules d'une feuille à une autre

VBA Selection jusqu'a derniere cellule pleine