Question

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

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

以下是我的代码到目前为止的样子：

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

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

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工作表复制到Powerpoint幻灯片

1 个答案: