Copier-coller graphique via macro

[paristlse]

Bonjour,

Voilà je souhaite faire un copier-coller d'un graphique d'une feuille excel à une autre dans le même classeur via une macro.

Problème... avec mon code, la dimension du graphique n'est pas conforme à l'original et le graph se colle un peu n'importe où sur la 2ème.

Voici le code que j'utilise.
WkMB.ChartObjects("Graphique 10").Copy
Application.Run "BLPLinkReset"
WkeMail.Range("C14").Select
WkeMail.PasteSpecial
Application.CutCopyMode = False

L'idée générale dans tout ça, c'est que j'ai un fichier avec mes données que je'envoie par email via ma macro. donc je crée une feuille excel virtuelle qui est en fait la phase de mise en forme avant l'envoi du mail. C'est à partir de cette feuille virtuelle que je copie les données dans le mail. Toutes les données sont copiées correctement, sauf les graphiques. Je pense qu'il faudrait que je les colle sous un autre format... et c'est là, où je suis perdu. Le premier copié-collé ne doit pas être écrit de manière correcte...

Malheureusement, je ne peux pas vous envoyer mon fichier, il est trop gros, même en l'allégeant au max...

Merci de votre aide.

Nicolas.


Voici le code à la place du fichier, désolé pour le message à rallonge.

Sub eMailSender()

'envoi du mail
Dim objOutlookApp As Outlook.Application
Dim objMailMessage As Outlook.MailItem
Dim objInspector As Outlook.Inspector
Dim objWordDoc As Word.Document
Dim Recipient As String
Dim WkH, WkMB, WkeMail As Worksheet

With Workbooks("Monetary_basis_Issuers_dev.xls")

Set WkH = .Worksheets("Histo")
Set WkMB = .Worksheets("Monetary_basis")
'Création sheet temporaire
Set WkeMail = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))

End With

Set objOutlookApp = CreateObject("Outlook.Application")
Set objMailMessage = objOutlookApp.CreateItem(olMailItem)


'Mise en page de l'email dans la feuille "eMail"
WkeMail.Rows.Clear
WkeMail.Range("A1").Value = "Bonjour,"
WkeMail.Range("A3").Value = "Voici quelques informations sur les Taux et le marché Monétaire pour la journée du " & Date & " :"

'Copie Taux directeurs
WkMB.Range("C11").Copy
WkeMail.Range("B6:C6").PasteSpecial
Application.CutCopyMode = False
WkMB.Range("C25").Copy
WkeMail.Range("B7:C10").PasteSpecial xlPasteValues
Application.CutCopyMode = False
WkMB.Range("C25").Copy
WkeMail.Range("B7:C10").PasteSpecial xlPasteFormats
Application.CutCopyMode = False

'Copie Eonia
WkMB.Range("C7").Copy
WkeMail.Range("B12").PasteSpecial
Application.CutCopyMode = False
WkMB.Range("D7").Copy
WkeMail.Range("C12").PasteSpecial xlPasteValues
Application.CutCopyMode = False
WkMB.Range("D7").Copy
WkeMail.Range("C12").PasteSpecial xlPasteFormats
Application.CutCopyMode = False

'Copie Swap vs Eonia
WkMB.Range("F1:G1").Copy
WkeMail.Range("E6:F6").PasteSpecial
Application.CutCopyMode = False
WkMB.Range("F2:G7").Copy
WkeMail.Range("E7:F12").PasteSpecial xlPasteValues
Application.CutCopyMode = False
WkMB.Range("F2:G7").Copy
WkeMail.Range("E7:F12").PasteSpecial xlPasteFormats
Application.CutCopyMode = False

'Copie Euribor
WkMB.Range("J1:K1").Copy
WkeMail.Range("H6:I6").PasteSpecial
Application.CutCopyMode = False
WkMB.Range("J2:K7").Copy
WkeMail.Range("H7:I12").PasteSpecial xlPasteValues
Application.CutCopyMode = False
WkMB.Range("J2:K7").Copy
WkeMail.Range("H7:I12").PasteSpecial xlPasteFormats
Application.CutCopyMode = False

'Copie Libor Eur
WkMB.Range("M1:N1").Copy
WkeMail.Range("K6:L6").PasteSpecial
Application.CutCopyMode = False
WkMB.Range("M2:N7").Copy
WkeMail.Range("K7:L12").PasteSpecial xlPasteValues
Application.CutCopyMode = False
WkMB.Range("M2:N7").Copy
WkeMail.Range("K7:L12").PasteSpecial xlPasteFormats
Application.CutCopyMode = False

'Copie Graph SvsE, Euribor, Libor Eur
WkMB.ChartObjects("Graphique 10").Copy
Application.Run "BLPLinkReset"
WkeMail.Range("C14").Select
WkeMail.PasteSpecial
Application.CutCopyMode = False

'Copie Note
WkMB.Range("B29").Copy
WkeMail.Range("B34").PasteSpecial
Application.CutCopyMode = False
WkMB.Range("C29:N33").Copy
WkeMail.Range("C34:N38").PasteSpecial
Application.CutCopyMode = False

'Niveaux Emetteurs
WkMB.Range("A37:A78").Copy
WkeMail.Range("A42:A83").PasteSpecial
Application.CutCopyMode = False

WkMB.Range("C35:N35").Copy
WkeMail.Range("C40:N40").PasteSpecial
Application.CutCopyMode = False

WkMB.Range("B36:N36").Copy
WkeMail.Range("B41:N41").PasteSpecial
Application.CutCopyMode = False

WkMB.Range("B37:N37").Copy
WkeMail.Range("B42:N42").PasteSpecial
Application.CutCopyMode = False

WkMB.Range("B38:N51").Copy
WkeMail.Range("B43:N56").PasteSpecial xlPasteValues
Application.CutCopyMode = False

WkMB.Range("B38:N51").Copy
WkeMail.Range("B43:N56").PasteSpecial xlPasteFormats
Application.CutCopyMode = False

WkMB.Range("B52:N52").Copy
WkeMail.Range("B57:N57").PasteSpecial
Application.CutCopyMode = False

WkMB.Range("B53:N78").Copy
WkeMail.Range("B58:N83").PasteSpecial xlPasteValues
Application.CutCopyMode = False

WkMB.Range("B53:N78").Copy
WkeMail.Range("B58:N83").PasteSpecial xlPasteFormats
Application.CutCopyMode = False

'Niveaux Moyenne Code
WkMB.Range("A79:N79").Copy
WkeMail.Range("A84:N84").PasteSpecial
Application.CutCopyMode = False

WkMB.Range("A80:B81").Copy
WkeMail.Range("A85:B86").PasteSpecial
Application.CutCopyMode = False

WkMB.Range("C80:N81").Copy
WkeMail.Range("C85:N86").PasteSpecial xlPasteValues
Application.CutCopyMode = False

WkMB.Range("C80:N81").Copy
WkeMail.Range("C85:N86").PasteSpecial xlPasteFormats
Application.CutCopyMode = False

'Copie Graph Moyenne Code 2
WkMB.ChartObjects("Graphique 24").Copy
Application.Run "BLPLinkReset"
WkeMail.Range("C88").Select
WkeMail.PasteSpecial
Application.Run "BLPLinkReset"
Application.CutCopyMode = False

'Copie Graph Moyenne Code 3
WkMB.ChartObjects("Graphique 25").Copy
Application.Run "BLPLinkReset"
WkeMail.Range("C108").Select
WkeMail.Paste
Application.Run "BLPLinkReset"
Application.CutCopyMode = False

WkeMail.Range("A130").Value = "Bonne journée,"
WkeMail.Range("A132").Value = "Cordialement,"

'Mise en forme avant envoi
With WkeMail.Range("A1:A3").Font
.Size = 11
.ColorIndex = 11
End With

With WkeMail.Range("A130:A132").Font
.Size = 11
.ColorIndex = 11
End With

' With WkeMail.Range("B34").Font
' .Size = 11
' .ColorIndex = 11
' .Bold = True
' End With

' With WkeMail.Range("C34:N38").Font
' .Size = 11
' .ColorIndex = 11
' End With

'With WkeMail.Range("B15:M18").Selection
' .Borders(xlInsideVertical).LineStyle = xlNone
' .Borders(xlInsideHorizontal).LineStyle = xlNone
'End With

WkeMail.Columns("A").ColumnWidth = 18
WkeMail.Columns("B:N").ColumnWidth = 8


'Génération de l'email
Recipient = "Pilorget Nicolas"

With objMailMessage
.To = Recipient
.Subject = Date & " - Infos Taux et Monétaires - ADO/MON"

WkeMail.Range("A1:N133").Copy
Set objInspector = objMailMessage.GetInspector
objInspector.Display
Set objWordDoc = objInspector.WordEditor

With objWordDoc.ActiveWindow.Selection
.TypeParagraph
.PasteSpecial
End With

Application.CutCopyMode = False

End With

'Désactivation alerte xls
Application.DisplayAlerts = False

'Suppression sheet temporaire
With Workbooks("Monetary_basis_Issuers_dev.xls")

.Worksheets(.Worksheets.Count).Delete

End With

'Réactivation alerte xls
Application.DisplayAlerts = True

Workbooks("Monetary_basis_Issuers_dev.xls").Worksheets("Monetary_basis").Activate

End Sub