复制粘贴excel到ppt,数据在错误的幻灯片上

时间:2017-09-08 10:35:11

标签: vba excel-vba powerpoint copy-paste excel

我有以下代码。它从excel获取数据并将其粘贴到PPT模板中。 如您所见,我使用ppSlide来跟踪我当前在哪张幻灯片上。为此,我在之前完成幻灯片时设置了下一张幻灯片的编号。

但是,当我运行代码时,它会将第二个文件粘贴到第二张幻灯片上(应该是第三张幻灯片)。关于为什么的任何想法?

Sub maakPPT()

Application.ScreenUpdating = False

    Dim ppApp As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    Dim ppSlide As PowerPoint.Slide
    Dim wsReoOverzicht As Worksheet
    Dim chPlanning As Chart
    Dim grafPersImp As Range
    Dim wsGrafiek  As Worksheet

    Set wsReoOverzicht = Worksheets("Reo's gestart")
    Set chPlanning = Charts("Planning")
    Set wsGrafiek = Worksheets("Grafiek")
    Set grafPersImp = wsGrafiek.Range("A3:N24")

    'ppt openen
    Set ppApp = New PowerPoint.Application
    ppApp.Visible = True
    ppApp.Activate

    'template openen 2e slide selecteren
    Set ppPres = ppApp.Presentations.Open("F:\WGD\Dep 456566-Centrale Reorganisatieteam\AAB CRT Algemeen\PMO CRT\Dashboards\ppt presentaties\Template Totaaloverzicht.pptx")
    Set ppSlide = ppPres.Slides(2)

    'Totaal lopende Reo's (planning)
    wsReoOverzicht.ListObjects("Tabel1").Range.AutoFilter Field:=12, Criteria1:= _
    "Lopend"
    chPlanning.CopyPicture _
    Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

    ppSlide.Select
    ppApp.ActiveWindow.View.Paste
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    ppSlide.Shapes(2).Width = 600
    ppSlide.Shapes(2).Height = 375
    ppSlide.Shapes.Range(2).Align msoAlignCenters, True
    ppSlide.Shapes.Range(2).Align msoAlignMiddles, True
    Set ppSlide = ppApp.ActivePresentation.Slides(3)

   'Totaal personele impact (grafiek)
   grafPersImp.Copy
   ppApp.ActiveWindow.View.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
   ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
   ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
   ppSlide.Shapes(2).Width = 400
   ppSlide.Shapes(2).Height = 275
   ppSlide.Shapes.Range(2).Align msoAlignCenters, True
   ppSlide.Shapes.Range(2).Align msoAlignMiddles, True
   Set ppSlide = ppApp.ActivePresentation.Slides(4)

1 个答案:

答案 0 :(得分:0)

与第一个绘画步骤的不同之处在于我没有使用ppSlide.select使其成为活动表。