Question

我试图在一张PowerPoint幻灯片中粘贴一个Excel图表，但是，在此过程中丢失了源格式。要求您提供代码帮助。

当前我正在使用以下代码：

Sub EuropeMoneyBall()

Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim MainWB As Workbook
Dim MBSheet1 As Worksheet
Dim MBSheet2 As Worksheet

Application.DisplayAlerts = False

'*****************Open Excel file where charts are saved*********************

Workbooks.Open Filename:="J:\Research\Internal\Moneyball.xlsx"
Set MainWB = Workbooks("Moneyball.xlsx")
Set MBSheet1 = MainWB.Sheets("1Y Charts")
Set MBSheet2 = MainWB.Sheets("3Y Charts")

'*****************Open Powerpoint where charts are to be saved********************

If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")

Set myPresentation = PowerPointApp.ActivePresentation
Set mySlide = myPresentation.Slides(16)

MBSheet1.Activate
MBSheet1.ChartObjects("Chart 1").Chart.ChartArea.Copy

With mySlide
    With .Shapes.Paste
        .Top = Application.CentimetersToPoints(4.11)
        .Left = Application.CentimetersToPoints(0.73)
        .Height = Application.CentimetersToPoints(9.47)
        .Width = Application.CentimetersToPoints(11.54)
    End With
End With

myPresentation.Application.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"

MBSheet2.Activate
MBSheet2.ChartObjects("Chart 1").Chart.ChartArea.Copy

With mySlide
    With .Shapes.Paste
        .Top = Application.CentimetersToPoints(4.11)
        .Left = Application.CentimetersToPoints(12.87)
        .Height = Application.CentimetersToPoints(9.47)
        .Width = Application.CentimetersToPoints(11.54)
    End With
End With

Application.DisplayAlerts = True

End Sub

感谢您的帮助。

谢谢罗汉

使用VBA在Excel中粘贴Excel图表并保持源格式

0 个答案: