image dans mail

Le
Excell
Bonjour tout le monde

Voici le code que j'utilise pour envoyer un mail en cliquant sur un
bouton,il y a une image a integrer dans la plage selectionnée(en cellule
"l3")

Sub Button16_Click()
'Working in 2000-2007
Dim picpicture As IPictureDisp
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.jpg")


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 "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)
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 xlPasterowheight
.Range(c.Address).PasteSpecial xlPasteValues
.Range(c.Address).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Next c

Range("L3").Select
.Picture.Insert ("c:image.jpg").select

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 = "adresse d'expedition"
.cc = ""
.BCC = ""
.Subject = "blabal"
.Body = "blabla " & wb
.Attachments.Add Dest.FullName
.Display 'or use .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


Mon souci est lors de la compilation tout est ok,

lors de l'execution j'ai le message d'erreur suivant "erreur 438
:propriété ou méthode non gérée par cet objet"

et le debogage va a la ligne ".Picture.Insert ("c:image.jpg").select

Pourriez vous me dire comment resoudre le probleme car l'image n'est
jamais integrée au document que je veux envoyé
Si je n'azvait pas l'image, il n'y aurait pas de probleme
D'autres idées concernant l'image(elle est absolument necessaire sur le
document a envoyer car ces une signature)
soont les bienvenues

D'avance merci pour votre aide
Bonne journée
RP
Ps: merci a daniel c pour son aide precedente

--
Utilisant le client e-mail révolutionnaire d'Opera :
http://www.opera.com/mail/
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
LSteph
Le #5106261
Bonjour,
chez moi avec ceci j'y arrive:

Sub insimg()
Feuil1.Activate
[L3].Select
ActiveSheet.Pictures.Insert ("c:image1.bmp")
ActiveSheet.Copy
ActiveWorkbook.SendMail "", "monsujet"
End Sub

'lSteph

Bonjour tout le monde

Voici le code que j'utilise pour envoyer un mail en cliquant sur un
bouton,il y a une image a integrer dans la plage selectionnée(en cellule
"l3")

Sub Button16_Click()
'Working in 2000-2007
Dim picpicture As IPictureDisp
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.jpg")


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 "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)
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 xlPasterowheight
.Range(c.Address).PasteSpecial xlPasteValues
.Range(c.Address).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Next c

Range("L3").Select
.Picture.Insert ("c:image.jpg").select

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 = "adresse d'expedition"
.cc = ""
.BCC = ""
.Subject = "blabal"
.Body = "blabla...... " & wb
.Attachments.Add Dest.FullName
.Display 'or use .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


Mon souci est lors de la compilation tout est ok,

lors de l'execution j'ai le message d'erreur suivant "erreur 438
:propriété ou méthode non gérée par cet objet"

et le debogage va a la ligne ".Picture.Insert ("c:image.jpg").select

Pourriez vous me dire comment resoudre le probleme car l'image n'est
jamais integrée au document que je veux envoyé
Si je n'azvait pas l'image, il n'y aurait pas de probleme
D'autres idées concernant l'image(elle est absolument necessaire sur le
document a envoyer car ces une signature)
soont les bienvenues

D'avance merci pour votre aide
Bonne journée
RP
Ps: merci a daniel c pour son aide precedente



Excell
Le #5120191
Le Sat, 22 Dec 2007 13:27:27 +0100, LSteph Bonjour tout le monde,
meilleurs voeux pour l'année 2008

Pour qui cela pourrais eventuellement interesser, voici un code pour
envoyer un mail, en cliquant sur un bouton, avec une image a inserer dans
une cellule bien precise, et quelques retouches concernant la mise en page.
Tessté et fonctionne pas mal avec windows pro sp2, excell 2003 et outlook
2003


Merci a LSteph et Daniel.C pour l'aide

Sub Button16_Click()
Dim picpicture As IPictureDisp
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)
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 "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
wb = Sheets("Rapports").Range("c3") 'ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
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
With ActiveSheet.Rows(3)
.RowHeight = 42
End With
With ActiveSheet.Rows(4)
.RowHeight = 3
End With
With ActiveSheet.Rows(6)
.RowHeight = 0
End With
With ActiveSheet.Columns("A")
.ColumnWidth = .ColumnWidth / 5
End With
[L3].Select
ActiveSheet.Pictures.Insert ("adresse de l'image.jpg")
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 = "adresse du "
.cc = ""
.BCC = ""
.Subject = "titre, sujet"
.Body = "texte du message " & wb
.Attachments.Add Dest.FullName
.Display 'or use .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



--
Utilisant le client e-mail révolutionnaire d'Opera :
http://www.opera.com/mail/
Publicité
Poster une réponse
Anonyme