Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel mise en page mail

mise en page mail

23 réponses
Avatar
Excell
Bonjour tout le monde,


Apres les aides recues et trouvée sur d'autres sites, en anglais,
voici le code que j'utilise pour envoyer un mail avec une plage
selectionnée en cliquant sur un bouton de commande.

Sub Button16_Click()
'Working in 2000-2007
Dim Source As Range
Dim Dest As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Set Source = Nothing
On Error Resume Next
Set Source = Range("b2:u43").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "La source n'est pas selectionnée ou la feuille est
protégée, corrigé svp et réessayé.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Set
wb = Sheets("Rapports").Range("c3") 'ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Rapport hebdomadaire de " & wb '.Name & " " &
Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
End If
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = ""
.cc = ""
.BCC = ""
.Subject = "Rapport hebdomadaire"
.Body = "Bonjour, voici mon rapport hebdomadaire. " & wb
.Attachments.Add Dest.FullName
.Display 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub


Le seul probleme que j'ai avec ce code est que dans la piece jointe, je
n'ai plus aucun respect de ma mise en page, qui sera necessaire aux
administratif lors de l'impression ???

Comment puis je resoudre ce probleme (si cela est necessaire, peut etre
convertir ma plage de selection en pdf dans un ficvhier temporaire, mais
j'ai vu qu'il fallait 4 applications ???)

D'autres methodes peuvent etres proposée si necessaire

La question que je me pose est que veut dire "FileExtStr = ".xls":
FileFormatNum = -4143" je ne comprends pas trop bien cette ligne de code

Merci pour votre aide
Bonne journée

RP


--
Utilisant le client e-mail révolutionnaire d'Opera :
http://www.opera.com/mail/
Signaler un problème avec ce contenu

3 réponses

Supprimer
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
1 2 3
Avatar
Excell
Encore pareil, est ce qu'il n'existerait pas une autre methode ???

Le Thu, 20 Dec 2007 16:00:53 +0100, Daniel.C a
écrit:

Oups.
.Pictures.Insert("c:image.jpeg").Select
Daniel
"Excell" a écrit dans le message de news:


j'ai toujours le meme message d'erreur,
désolé


Le Thu, 20 Dec 2007 14:15:31 +0100, Daniel.C a
écrit:

Tu insères l'image sur la feuille d'origine, pas sur le classeur que tu
mets
en pièce jointe.
Modifie :

With Dest.Sheets(1)
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.CentimetersToPoints(0.1)
.RightMargin = Application.CentimetersToPoints(0.1)
.TopMargin = Application.CentimetersToPoints(0.1)
.BottomMargin = Application.CentimetersToPoints(0.1)
End With
For Each c In Source
c.Copy
.Range(c.Address).PasteSpecial xlPasteColumnWidths
.Range(c.Address).PasteSpecial xlPasteValues
.Range(c.Address).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Next c
End With

en :

With Dest.Sheets(1)
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.CentimetersToPoints(0.1)
.RightMargin = Application.CentimetersToPoints(0.1)
.TopMargin = Application.CentimetersToPoints(0.1)
.BottomMargin = Application.CentimetersToPoints(0.1)
End With
For Each c In Source
c.Copy
.Range(c.Address).PasteSpecial xlPasteColumnWidths
.Range(c.Address).PasteSpecial xlPasteValues
.Range(c.Address).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Next c
.Range("L3").Select
.Picture.Insert ("c:image.jpeg")
End With

Modifie le "L3" pour positionner la signature sur la feuille.
Daniel
"Excell" a écrit dans le message de news:

voici la nouvelle version du code

Sub Button16_Click()
'Working in 2000-2007
Dim Source As Range
Dim Dest As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Set Source = Nothing
On Error Resume Next
Set Source = Range("a1:u44").SpecialCells(xlCellTypeVisible)

Range("L3").Select
ActiveSheet.Picture.Insert ("c:image.jpeg")

With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Picture = picpicture
.LeftMargin = Application.CentimetersToPoints(0.1)
.RightMargin = Application.CentimetersToPoints(0.1)
.TopMargin = Application.CentimetersToPoints(0.1)
.BottomMargin = Application.CentimetersToPoints(0.1)
End With
On Error GoTo 0
If Source Is Nothing Then
MsgBox "blabala.....", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Set
wb = Sheets("Rapports").Range("c3") 'ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy

' Range("L3").Select
' ActiveSheet.Picture.Insert ("c:image.jpeg")

With Dest.Sheets(1)
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.CentimetersToPoints(0.1)
.RightMargin = Application.CentimetersToPoints(0.1)
.TopMargin = Application.CentimetersToPoints(0.1)
.BottomMargin = Application.CentimetersToPoints(0.1)
End With
For Each c In Source
c.Copy
.Range(c.Address).PasteSpecial xlPasteColumnWidths
.Range(c.Address).PasteSpecial xlPasteValues
.Range(c.Address).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Next c
end With
TempFilePath = Environ$("temp") & ""
TempFileName = "Rapport hebdomadaire de " & wb '.Name & " " &
Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
End If
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "adressemail"
.cc = ""
.BCC = ""
.Subject = "Rapport hebdomadaire"
.Body = "Bonjour, voici mon rapport hebdomadaire. " & wb
.Attachments.Add Dest.FullName
.Display
End With
On Error GoTo 0
.Close savechanges:úlse
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub


Là ou j'ai mis les lignes pour l'image(14 eme ligne),ok le document
est
envoyé sans l'image
ailleurs(ou en plus des lignes 14 et 15), comme celles mises en
commentaire sur ce code, j'ai une erreur et excell me dit "erreur
d'execution'438':propriete et methode non gérée par cet objet" et le
debogage va sur la ligne
ActiveSheet.Picture.Insert ("c:image.jpeg")

Le Thu, 20 Dec 2007 12:45:19 +0100, Daniel.C
a
écrit:

Bonjour.
L'image doit être collée dans le classeur mis en pièce jointe.
Poste ton code modifié.
Daniel
"Excell" a écrit dans le message de news:

Bonjour,

apres beeaucoup d'essai, l'image n'apparait jamais.
La je coinces
merci pour l'aide
RP

le client e-mail révolutionnaire d'Opera : http://www.opera.com/mail/









--
Utilisant le client e-mail révolutionnaire d'Opera :
http://www.opera.com/mail/







--
Utilisant le client e-mail révolutionnaire d'Opera :
http://www.opera.com/mail/






Avatar
Daniel.C
Je ne suis pas trop à l'aise avec les images. Ce que je t'ai donné, je l'ai
eu avec l'enregistreur de macros. Tu devrais ouvrir un nouveau fil pour
l'insertion d'image.
Daniel
"Daniel.C" a écrit dans le message de news:

Oups.
.Pictures.Insert("c:image.jpeg").Select
Daniel
"Excell" a écrit dans le message de news:


j'ai toujours le meme message d'erreur,
désolé


Le Thu, 20 Dec 2007 14:15:31 +0100, Daniel.C a
écrit:

Tu insères l'image sur la feuille d'origine, pas sur le classeur que tu
mets
en pièce jointe.
Modifie :

With Dest.Sheets(1)
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.CentimetersToPoints(0.1)
.RightMargin = Application.CentimetersToPoints(0.1)
.TopMargin = Application.CentimetersToPoints(0.1)
.BottomMargin = Application.CentimetersToPoints(0.1)
End With
For Each c In Source
c.Copy
.Range(c.Address).PasteSpecial xlPasteColumnWidths
.Range(c.Address).PasteSpecial xlPasteValues
.Range(c.Address).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Next c
End With

en :

With Dest.Sheets(1)
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.CentimetersToPoints(0.1)
.RightMargin = Application.CentimetersToPoints(0.1)
.TopMargin = Application.CentimetersToPoints(0.1)
.BottomMargin = Application.CentimetersToPoints(0.1)
End With
For Each c In Source
c.Copy
.Range(c.Address).PasteSpecial xlPasteColumnWidths
.Range(c.Address).PasteSpecial xlPasteValues
.Range(c.Address).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Next c
.Range("L3").Select
.Picture.Insert ("c:image.jpeg")
End With

Modifie le "L3" pour positionner la signature sur la feuille.
Daniel
"Excell" a écrit dans le message de news:

voici la nouvelle version du code

Sub Button16_Click()
'Working in 2000-2007
Dim Source As Range
Dim Dest As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Set Source = Nothing
On Error Resume Next
Set Source = Range("a1:u44").SpecialCells(xlCellTypeVisible)

Range("L3").Select
ActiveSheet.Picture.Insert ("c:image.jpeg")

With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Picture = picpicture
.LeftMargin = Application.CentimetersToPoints(0.1)
.RightMargin = Application.CentimetersToPoints(0.1)
.TopMargin = Application.CentimetersToPoints(0.1)
.BottomMargin = Application.CentimetersToPoints(0.1)
End With
On Error GoTo 0
If Source Is Nothing Then
MsgBox "blabala.....", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Set
wb = Sheets("Rapports").Range("c3") 'ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy

' Range("L3").Select
' ActiveSheet.Picture.Insert ("c:image.jpeg")

With Dest.Sheets(1)
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.CentimetersToPoints(0.1)
.RightMargin = Application.CentimetersToPoints(0.1)
.TopMargin = Application.CentimetersToPoints(0.1)
.BottomMargin = Application.CentimetersToPoints(0.1)
End With
For Each c In Source
c.Copy
.Range(c.Address).PasteSpecial xlPasteColumnWidths
.Range(c.Address).PasteSpecial xlPasteValues
.Range(c.Address).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Next c
end With
TempFilePath = Environ$("temp") & ""
TempFileName = "Rapport hebdomadaire de " & wb '.Name & " " &
Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
End If
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "adressemail"
.cc = ""
.BCC = ""
.Subject = "Rapport hebdomadaire"
.Body = "Bonjour, voici mon rapport hebdomadaire. " & wb
.Attachments.Add Dest.FullName
.Display
End With
On Error GoTo 0
.Close savechanges:úlse
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub


Là ou j'ai mis les lignes pour l'image(14 eme ligne),ok le document est
envoyé sans l'image
ailleurs(ou en plus des lignes 14 et 15), comme celles mises en
commentaire sur ce code, j'ai une erreur et excell me dit "erreur
d'execution'438':propriete et methode non gérée par cet objet" et le
debogage va sur la ligne
ActiveSheet.Picture.Insert ("c:image.jpeg")

Le Thu, 20 Dec 2007 12:45:19 +0100, Daniel.C a
écrit:

Bonjour.
L'image doit être collée dans le classeur mis en pièce jointe.
Poste ton code modifié.
Daniel
"Excell" a écrit dans le message de news:

Bonjour,

apres beeaucoup d'essai, l'image n'apparait jamais.
La je coinces
merci pour l'aide
RP

le client e-mail révolutionnaire d'Opera : http://www.opera.com/mail/









--
Utilisant le client e-mail révolutionnaire d'Opera :
http://www.opera.com/mail/










Avatar
Excell
bonjour,

pas de probleme,

merci beaucoup pour l'aide


Le Thu, 20 Dec 2007 23:27:01 +0100, Daniel.C a
écrit:

Je ne suis pas trop à l'aise avec les images. Ce que je t'ai donné, je
l'ai
eu avec l'enregistreur de macros. Tu devrais ouvrir un nouveau fil pour
l'insertion d'image.
Daniel
"Daniel.C" a écrit dans le message de news:

Oups.
.Pictures.Insert("c:image.jpeg").Select
Daniel
"Excell" a écrit dans le message de news:


j'ai toujours le meme message d'erreur,
désolé


Le Thu, 20 Dec 2007 14:15:31 +0100, Daniel.C a
écrit:

Tu insères l'image sur la feuille d'origine, pas sur le classeur que
tu
mets
en pièce jointe.
Modifie :

With Dest.Sheets(1)
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.CentimetersToPoints(0.1)
.RightMargin = Application.CentimetersToPoints(0.1)
.TopMargin = Application.CentimetersToPoints(0.1)
.BottomMargin = Application.CentimetersToPoints(0.1)
End With
For Each c In Source
c.Copy
.Range(c.Address).PasteSpecial xlPasteColumnWidths
.Range(c.Address).PasteSpecial xlPasteValues
.Range(c.Address).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Next c
End With

en :

With Dest.Sheets(1)
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.CentimetersToPoints(0.1)
.RightMargin = Application.CentimetersToPoints(0.1)
.TopMargin = Application.CentimetersToPoints(0.1)
.BottomMargin = Application.CentimetersToPoints(0.1)
End With
For Each c In Source
c.Copy
.Range(c.Address).PasteSpecial xlPasteColumnWidths
.Range(c.Address).PasteSpecial xlPasteValues
.Range(c.Address).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Next c
.Range("L3").Select
.Picture.Insert ("c:image.jpeg")
End With

Modifie le "L3" pour positionner la signature sur la feuille.
Daniel
"Excell" a écrit dans le message de news:

voici la nouvelle version du code

Sub Button16_Click()
'Working in 2000-2007
Dim Source As Range
Dim Dest As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Set Source = Nothing
On Error Resume Next
Set Source = Range("a1:u44").SpecialCells(xlCellTypeVisible)

Range("L3").Select
ActiveSheet.Picture.Insert ("c:image.jpeg")

With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Picture = picpicture
.LeftMargin = Application.CentimetersToPoints(0.1)
.RightMargin = Application.CentimetersToPoints(0.1)
.TopMargin = Application.CentimetersToPoints(0.1)
.BottomMargin = Application.CentimetersToPoints(0.1)
End With
On Error GoTo 0
If Source Is Nothing Then
MsgBox "blabala.....", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Set
wb = Sheets("Rapports").Range("c3") 'ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy

' Range("L3").Select
' ActiveSheet.Picture.Insert ("c:image.jpeg")

With Dest.Sheets(1)
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.CentimetersToPoints(0.1)
.RightMargin = Application.CentimetersToPoints(0.1)
.TopMargin = Application.CentimetersToPoints(0.1)
.BottomMargin = Application.CentimetersToPoints(0.1)
End With
For Each c In Source
c.Copy
.Range(c.Address).PasteSpecial xlPasteColumnWidths
.Range(c.Address).PasteSpecial xlPasteValues
.Range(c.Address).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Next c
end With
TempFilePath = Environ$("temp") & ""
TempFileName = "Rapport hebdomadaire de " & wb '.Name & " " &
Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
End If
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "adressemail"
.cc = ""
.BCC = ""
.Subject = "Rapport hebdomadaire"
.Body = "Bonjour, voici mon rapport hebdomadaire. " & wb
.Attachments.Add Dest.FullName
.Display
End With
On Error GoTo 0
.Close savechanges:úlse
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub


Là ou j'ai mis les lignes pour l'image(14 eme ligne),ok le document
est
envoyé sans l'image
ailleurs(ou en plus des lignes 14 et 15), comme celles mises en
commentaire sur ce code, j'ai une erreur et excell me dit "erreur
d'execution'438':propriete et methode non gérée par cet objet" et le
debogage va sur la ligne
ActiveSheet.Picture.Insert ("c:image.jpeg")

Le Thu, 20 Dec 2007 12:45:19 +0100, Daniel.C
a
écrit:

Bonjour.
L'image doit être collée dans le classeur mis en pièce jointe.
Poste ton code modifié.
Daniel
"Excell" a écrit dans le message de news:

Bonjour,

apres beeaucoup d'essai, l'image n'apparait jamais.
La je coinces
merci pour l'aide
RP

le client e-mail révolutionnaire d'Opera :


http://www.opera.com/mail/







--
Utilisant le client e-mail révolutionnaire d'Opera :
http://www.opera.com/mail/










--
Utilisant le client e-mail révolutionnaire d'Opera :
http://www.opera.com/mail/







1 2 3