如何将单个或所有图表从Excel工作表导出到PowerPoint？

有时，出于某些目的，您可能需要将图表或所有图表从Excel导出到PowerPoint。本文讨论的是如何实现它。

使用VBA代码将单个图表或所有图表从Excel工作表导出到PowerPoint

使用VBA代码将单个图表或所有图表从Excel工作表导出到PowerPoint

惊人的！在 Excel 中使用高效的选项卡，如 Chrome、Edge、Firefox 和 Safari！
每天节省50％的时间，并减少数千次鼠标单击！

本节将介绍VBA代码，以将单个图表或所有图表从工作簿导出到PowerPoint。请执行以下操作。

1。按其他 + F11 钥匙一起打开 Microsoft Visual Basic应用程序 窗口。

2.在 Microsoft Visual Basic应用程序 窗口中，单击工具 > 参考资料 如下图所示。

3.在 参考– VBAProject 对话框中，向下滚动以查找并检查 Microsoft PowerPoint对象库 选项，然后单击 OK 按钮。看截图：

4。然后点击插页 > 模块.

5.如果要将单个图表导出到PowerPoint，请转到在工作表中选择图表，然后返回到 Microsoft Visual Basic应用程序 窗口，将下面的VBA代码复制并粘贴到“模块”窗口中。

VBA代码：将单个图表从Excel工作表导出到PowerPoint

Sub SingleActiveChartToPowerPoint_EarlyBinding1()
'Updated by Extendoffice 2017/9/15
  Dim pptApp As PowerPoint.Application
  Dim pptPres As PowerPoint.Presentation
  Dim pptSlide As PowerPoint.Slide
  Dim pptShape As PowerPoint.Shape
  Dim pptShpRng As PowerPoint.ShapeRange
  Dim xActiveSlideNow As Long
  On Error Resume Next
  If ActiveChart Is Nothing Then
    MsgBox "Select a chart and try again!", vbExclamation, "KuTools For Excel"
    Exit Sub
  End If
  Set pptApp = GetObject(, "PowerPoint.Application")
  If pptApp Is Nothing Then
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPres = pptApp.Presentations.Add
    Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
  Else
    If pptApp.Presentations.Count > 0 Then
      Set pptPres = pptApp.ActivePresentation
      If pptPres.Slides.Count > 0 Then
        xActiveSlideNow = pptApp.ActiveWindow.View.Slide.SlideIndex
        Set pptSlide = pptPres.Slides(xActiveSlideNow)
      Else
        Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
      End If
    Else
      Set pptPres = pptApp.Presentations.Add
      Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
    End If
  End If
  ActiveChart.ChartArea.Copy
  With pptSlide
    .Shapes.Paste
    Set pptShape = .Shapes(.Shapes.Count)
    Set pptShpRng = .Shapes.Range(pptShape.Name)
  End With
  With pptShpRng
    .Align msoAlignCenters, True
    .Align msoAlignMiddles, True
  End With
  pptShpRng.Select
End Sub

如果要从工作簿中导出所有图表，请复制以下VBA代码并将其粘贴到“模块”窗口中。

VBA代码：将所有图表从Excel工作表导出到PowerPoint

Option Explicit
'Updated by Extendoffice 2017/9/15
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptSlideCount As Integer
Sub ChartsToPowerPoint()
    Dim xSheet As Worksheet
    Dim xChartsCount As Integer
    Dim xChart As Object
    Dim xActiveSlideNow As Integer
    On Error Resume Next
    For Each xSheet In ActiveWorkbook.Worksheets
        xChartsCount = xChartsCount + xSheet.ChartObjects.Count
    Next xSheet
    If xChartsCount = 0 Then
        MsgBox "Sorry, there are no charts to export!", vbCritical, "Ops"
        Exit Sub
    End If
    Set pptApp = GetObject(, "PowerPoint.Application")
    If pptApp Is Nothing Then
      Set pptApp = CreateObject("PowerPoint.Application")
      Set pptPres = pptApp.Presentations.Add
      Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
    Else
        If pptApp.Presentations.Count > 0 Then
          Set pptPres = pptApp.ActivePresentation
          If pptPres.Slides.Count > 0 Then
            xActiveSlideNow = pptApp.ActiveWindow.View.Slide.SlideIndex
            Set pptSlide = pptPres.Slides(xActiveSlideNow)
          Else
            Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
          End If
        Else
          Set pptPres = pptApp.Presentations.Add
          Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
        End If
    End If
    For Each xSheet In ActiveWorkbook.Worksheets
        For Each xChart In xSheet.ChartObjects
            Call pptFormat(xChart.Chart)
        Next xChart
    Next xSheet
    For Each xChart In ActiveWorkbook.Charts
        Call pptFormat(xChart)
    Next xChart
    
    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
    MsgBox "The charts were copied successfully to the new presentation!", vbInformation, "KuTools For Excel"
End Sub
Private Sub pptFormat(xChart As Chart)
    Dim xCharTiTle As String
    Dim I As Integer
    On Error Resume Next
    xCharTiTle = xChart.ChartTitle.Text
    xChart.ChartArea.Copy
    pptSlideCount = pptPres.Slides.Count
    Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank)
    pptSlide.Select
    pptSlide.Shapes.PasteSpecial ppPasteJPG
    If xCharTiTle <> "" Then
        pptSlide.Shapes.AddTextbox msoTextOrientationHorizontal, 12.5, 20, 694.75, 55.25
    End If
    For I = 1 To pptSlide.Shapes.Count
        With pptSlide.Shapes(I)
            Select Case .Type
                Case msoPicture:
                    .Top = 87.84976
                    .left = 33.98417
                    .Height = 422.7964
                    .Width = 646.5262
                Case msoTextBox:
                    With .TextFrame.TextRange
                        .ParagraphFormat.Alignment = ppAlignCenter
                        .Text = xCharTiTle
                        .Font.Name = "Tahoma (Headings)"
                        .Font.Size = 28
                        .Font.Bold = msoTrue
                    End With
                End Select
        End With
    Next I
End Sub

6。按 F5 键或单击“运行”按钮以运行代码。然后将打开一个新的PowerPoint，其中包含选定的图表或所有导入的图表。你会得到一个 Kutools for Excel 对话框如下图所示，请点击 OK 按钮。

最佳办公生产力工具

🤖	Kutools 人工智能助手：基于以下内容彻底改变数据分析：智能执行 \| 生成代码 \| 创建自定义公式 \| 分析数据并生成图表 \| 调用 Kutools 函数...
	热门特色: 查找、突出显示或识别重复项 \| 删除空白行 \| 合并列或单元格而不丢失数据 \| 不使用公式进行四舍五入 ...
	超级查询: 多条件VLookup \| 多值VLookup \| 跨多个工作表的 VLookup \| 模糊查询 ....
	高级下拉列表: 快速创建下拉列表 \| 依赖下拉列表 \| 多选下拉列表 ....
	列管理器: 添加特定数量的列 \| 移动列 \| 切换隐藏列的可见性状态 \| 比较范围和列 ...
	特色功能: 网格焦点 \| 设计图 \| 大方程式酒吧 \| 工作簿和工作表管理器 \| 资源库（自动文本） \| 日期选择器 \| 合并工作表 \| 加密/解密单元格 \| 按列表发送电子邮件 \| 超级筛选 \| 特殊过滤器（过滤粗体/斜体/删除线...）...
	前 15 个工具集: 12 文本工具 (添加文本, 删除字符，...） \| 50+ 图表类型 (甘特图，...） \| 40+ 实用公式 (根据生日计算年龄，...） \| 19 插入工具 (插入二维码, 从路径插入图片，...） \| 12 转化工具 (小写金额转大写, 货币兑换，...） \| 7 合并与拆分工具 (高级组合行, 分裂细胞，...） \| ... 和更多

使用 Kutools for Excel 增强您的 Excel 技能，体验前所未有的效率。 Kutools for Excel 提供了 300 多种高级功能来提高生产力并节省时间。单击此处获取您最需要的功能...

产品描述

阅读更多免费下载...

Office Tab 为 Office 带来选项卡式界面，让您的工作更加轻松

在Word，Excel，PowerPoint中启用选项卡式编辑和阅读，发布者，Access，Visio和Project。
在同一窗口的新选项卡中而不是在新窗口中打开并创建多个文档。
每天将您的工作效率提高50％，并减少数百次鼠标单击！

阅读更多免费下载...

Comments (7)

No ratings yet. Be the first to rate!

Carlos

about 2 years ago

#35456