将未链接的Excel图表粘贴到Powerpoint

我目前正在做一个项目，将50多组Excel图表转换为powerpoint演示文稿。我有50多个项目，我正在比较和制作50多个相同的图表。我在excel工作簿中设置它的方式是，图表始终是同一个图表（即图表2），但通过更改唯一的ID号，我的图表将来自工作表的不同区域

在通常情况下，我只会复制并粘贴图表作为图片

---

但是，在我的情况下，我还需要去掉所有数据标签，下面是可能的解决方案：

Sub Breaking_links()

Dim CHR As Shape

Set CHR = ActivePresentation.Slides(1).Shapes(3) 'for 3rd chart shape on 1st slide

CHR.Chart.ChartData.BreakLink

End Sub

简短解释-将图表复制到PP后，需要断开指向上面示例中的数据源的链接

---

而且，我认为您可以像在PP中一样轻松地在Excel中修改axis。如果您发现该选项更好，请向我们展示您的PP代码，这将有助于为您提供一些Excel提示。

如果您希望将Excel图表作为未链接对象粘贴到PowerPoint中，但仍将其作为嵌入式对象进行维护，我建议您将其粘贴为对象。粘贴过程如下所示：

'Create a new slide in the Presentation, set the layout to blank, and paste chart on to the newly added slide.
Set PPTSlide = PPTPres.Slides.Add(SldIndex, ppLayoutBlank)
               PPTSlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse

下面是一些简单的代码，您可以将工作簿中的多个图表作为一个对象粘贴到PowerPoint演示文稿中，而无需链接。

Sub ExportChartsToPowerPoint_MultipleWorksheets()

    ' OVERVIEW:
    ' This script will loop through all the worksheets in the Active Workbook
    ' and copy all the Charts to a new PowerPoint presentation that we create.
    ' Each chart will get their own individual slide and will be placed in the center of it.

    'Declare PowerPoint Variables
    Dim PPTApp As PowerPoint.Application
    Dim PPTPres As PowerPoint.Presentation
    Dim PPTSlide As PowerPoint.Slide
    Dim PPTShape As PowerPoint.Shape
    Dim SldIndex As Integer

    'Declare Excel Variables
    Dim Chrt As ChartObject
    Dim WrkSht As Worksheet

    'Create new PowerPoint Application & make it visible.
    Set PPTApp = New PowerPoint.Application
        PPTApp.Visible = True

    'Create new presentation in the PowerPoint application.
    Set PPTPres = PPTApp.Presentations.Add

    'Create an index handler for slide creation.
    SldIndex = 1

    'Loop throught all the Worksheets in the Worksheets Collection.
    For Each WrkSht In Worksheets

        'Loop through all the CHARTOBJECTS in the ACTIVESHEET.
        For Each Chrt In WrkSht.ChartObjects

            'Copy the Chart
            Chrt.Chart.ChartArea.Copy

            'Create a new slide in the Presentation, set the layout to blank, and paste chart on to the newly added slide.
            Set PPTSlide = PPTPres.Slides.Add(SldIndex, ppLayoutBlank)
                PPTSlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse

            'Increment index so that way we paste the next chart on the new slide that is added.
            SldIndex = SldIndex + 1

        Next Chrt

    Next WrkSht

End Sub

现在，这实际上是我在YouTube视频中看到的一些代码，所以如果你想浏览整个代码，我鼓励你访问下面的链接

全面披露这是我个人的YOUTUBE频道。

Sub ExportChartsToPowerPoint_MultipleWorksheets()

    ' OVERVIEW:
    ' This script will loop through all the worksheets in the Active Workbook
    ' and copy all the Charts to a new PowerPoint presentation that we create.
    ' Each chart will get their own individual slide and will be placed in the center of it.

    'Declare PowerPoint Variables
    Dim PPTApp As PowerPoint.Application
    Dim PPTPres As PowerPoint.Presentation
    Dim PPTSlide As PowerPoint.Slide
    Dim PPTShape As PowerPoint.Shape
    Dim SldIndex As Integer

    'Declare Excel Variables
    Dim Chrt As ChartObject
    Dim WrkSht As Worksheet

    'Create new PowerPoint Application & make it visible.
    Set PPTApp = New PowerPoint.Application
        PPTApp.Visible = True

    'Create new presentation in the PowerPoint application.
    Set PPTPres = PPTApp.Presentations.Add

    'Create an index handler for slide creation.
    SldIndex = 1

    'Loop throught all the Worksheets in the Worksheets Collection.
    For Each WrkSht In Worksheets

        'Loop through all the CHARTOBJECTS in the ACTIVESHEET.
        For Each Chrt In WrkSht.ChartObjects

            'Copy the Chart
            Chrt.Chart.ChartArea.Copy

            'Create a new slide in the Presentation, set the layout to blank, and paste chart on to the newly added slide.
            Set PPTSlide = PPTPres.Slides.Add(SldIndex, ppLayoutBlank)
                PPTSlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse

            'Increment index so that way we paste the next chart on the new slide that is added.
            SldIndex = SldIndex + 1

        Next Chrt

    Next WrkSht

End Sub