将 Excel Sheet 中的所有图表复制到 Powerpoint 幻灯片

Question

我建立了一个工作簿，以方便创建我负责的月度报告演示。该工作簿有一些数据 sheets，一些处理 sheets，然后编号为 sheets，其中包含我需要粘贴到相应幻灯片的图表。到目前为止，我已经构建了 VBA 用于打开 PowerPoint 模板并循环遍历每个 excel sheet，并区分哪些 sheet 名称是数字，然后激活相应的在 powerpoint 模板上滑动。

与我发现的类似问题的其他解决方案不同，我想一次将每个编号 sheet 中的所有图表复制到每张幻灯片，因为它们的形状、数量和配置都不同每个sheet/slide。我大多只发现人们一次复制一个图表并粘贴为图像，这对我也不起作用（我需要微调数据标签和在最后一张幻灯片上的位置）。关于如何实现的任何提示？

到目前为止，我的代码如下所示：

Sub CriarSlides()

Dim pptApp As Powerpoint.Application
Dim pptPres As Powerpoint.Presentation
Dim strFileToOpen As Variant
Dim strFileName As String, Hosp As String
Dim datawb As Workbook
Dim xlsCounter As Integer, xlsSlide As Integer


Set datawb = ThisWorkbook


strFileToOpen = Application.GetOpenFilename _
FileFilter:="Powerpoint Files *.pptx (*.pptx),")
If strFileToOpen = False Then
   Exit Sub
Else
   Set pptApp = New Powerpoint.Application
   pptApp.Visible = True
   pptApp.Presentations.Open Filename:=strFileToOpen, ReadOnly:=msoFalse, Untitled:=msoTrue
   Set pptPres = pptApp.Presentations(1)
End If

For xlsCounter = datawb.Worksheets.Count To 1 Step -1
    If IsNumeric(datawb.Worksheets(xlsCounter).Name) Then
       xlsSlide = datawb.Worksheets(xlsCounter).Name

' This is the problematic part

        Debug.Print xlsSlide
    End If
Next xlsCounter
End Sub

Answer 1

使用以下修改后的代码，您可以将每个 sheet 的图表对象粘贴到相应的幻灯片中：

Sub CriarSlides()
    Dim pptApp As PowerPoint.Application, pptPres As PowerPoint.Presentation
    Dim strFileToOpen As Variant, sh As Worksheet, ch As ChartObject

    strFileToOpen = Application.GetOpenFilename(FileFilter:="Powerpoint Files *.pptx (*.pptx),")
    If strFileToOpen = False Then Exit Sub
    Set pptApp = New PowerPoint.Application
    pptApp.Visible = True
    Set pptPres = pptApp.Presentations.Open(fileName:=strFileToOpen, ReadOnly:=msoFalse)

    For Each sh In ThisWorkbook.Sheets
        If IsNumeric(sh.name) Then
            For Each ch In sh.ChartObjects
                ch.Copy
                With pptPres.Slides(CLng(sh.name)).Shapes.Paste
                    .Top = ch.Top
                    .Left = ch.Left
                    .Width = ch.Width
                    .Height = ch.Height
                End With
            Next
        End If
    Next
End Sub

将 Excel Sheet 中的所有图表复制到 Powerpoint 幻灯片

Copying all charts from an Excel Sheet to a Powerpoint slide

excel

charts

powerpoint

vba