Bonjour,
J'ai un code me permettant d'envoyer un mail avec dans le corps de mail une copie image d'une plage de cellule de ma Feuil1 ( méthode Range(" ").CopyPicture)
Seule problématique, la taille de cette copie est trop petite et le rendu par mail n'est pas très lisible.
Cela m'oblige donc systématiquement à venir manuellement augmenter au maximum la taille de la copie image.
Deux questions :
1) Comment faire en sorte qu'avec ma méthode .CopyPicture la taille de mon image dans le corps de mail soit maximale ?
2) Comment faire en sorte que l'image copié dans le corps de mail soit de la meilleure qualité possible. A l'heure actuelle même en l'augmentant de manière manuelle elle reste de qualité moyenne.
Merci d'avance pour vos votre aide.
Bonne fin de journée
Ci-dessous le code que j'utilise. Il n'est certainement pas parfait, mais mis à part les deux problèmes cités plus haut il me va pour l'instant très bien
En commentaire dans le bas du code, les différents "test" que j'ai pu réaliser sans succès notamment avec la méthode
.Width
.Height
J'ai un code me permettant d'envoyer un mail avec dans le corps de mail une copie image d'une plage de cellule de ma Feuil1 ( méthode Range(" ").CopyPicture)
Seule problématique, la taille de cette copie est trop petite et le rendu par mail n'est pas très lisible.
Cela m'oblige donc systématiquement à venir manuellement augmenter au maximum la taille de la copie image.
Deux questions :
1) Comment faire en sorte qu'avec ma méthode .CopyPicture la taille de mon image dans le corps de mail soit maximale ?
2) Comment faire en sorte que l'image copié dans le corps de mail soit de la meilleure qualité possible. A l'heure actuelle même en l'augmentant de manière manuelle elle reste de qualité moyenne.
Merci d'avance pour vos votre aide.
Bonne fin de journée
Ci-dessous le code que j'utilise. Il n'est certainement pas parfait, mais mis à part les deux problèmes cités plus haut il me va pour l'instant très bien
En commentaire dans le bas du code, les différents "test" que j'ai pu réaliser sans succès notamment avec la méthode
.Width
.Height
VB:
Sub Mail()
Dim FileExtStr As String
Dim Texte As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape
Dim shp As Shape
Dim sNomFic As String, sRep As String, WshShell As Object
LD As String
Dim OL As Object, myItem As Object, wDoc As Object, rng As Object
Dim nb_lignes As Integer
Set OL = CreateObject("Outlook.Application")
Set myItem = OL.CreateItem(olMailItem)
Sheets("Feuil1").Activate
Dim oOutlook As Object
On Error Resume Next
Set oOutlook = GetObject(, "Outlook.application")
On Error GoTo 0
If oOutlook Is Nothing Then
Shell "Outlook.exe", vbHide
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
destrapportTT = ""
With Sheets("MAIL")
For idest = 1 To .[A1].End(xlDown).Row
destrapportTT = destrapportTT & .Cells(idest, "A").Value & ";"
Next idest
End With
Texte = Texte & "Bonjour," & vbCrLf
Texte = Texte & vbCrLf
Texte = Texte & "Cordialement" & vbCrLf
Texte = Texte & vbCrLf
LD = destrapportTT
Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = LD
.CC = ""
.Subject = " TEST "
.Body = Texte
.Display
.OriginatorDeliveryReportRequested = True ' Accusé de dépôt
.ReadReceiptRequested = True ' Accusé de lecture
.Importance = 2 ' Niveau d'importance du mail
'For Each shp In wordDoc.InlineShapes
' shp.ScaleHeight = 90
' shp.ScaleWidth = 90
'Next
'ActiveWindow.Zoom = 300
Set wDoc = myItem.GetInspector.WordEditor
Range("A3:Y95").CopyPicture xlScreen, xlPicture
':=xlPrinter, Format:=xlBitmap
'xlScreen, xlBitmap
' With .Shapes(ShapeCount)
' .Width = .Width * 0.75
' .Height = .Height * 0.75
' .Copy: .Delete
' End With
'Selection.ShapeRange.ScaleWidth 5.0965906893, msoFalse, msoScaleFromBottomRight
' Selection.ShapeRange.ScaleHeight 5.0965905176, msoFalse, _
' msoScaleFromBottomRight
wDoc.Application.Selection.Start = Len(.Body)
wDoc.Application.Selection.End = wDoc.Application.Selection.Start
wDoc.Application.Selection.Paste
'ActiveWindow.Zoom = 100
End With
End Sub
