Question

我将以下代码导出excel表到powerpoint。在每个工作表中，它从单元格A1和A2获取范围，并将范围复制到powerpoint中。

现在我想添加两个功能，但我不知道如何做到这一点，所以我希望有人可以帮我这个？

1 - 在仅包含表格的表格中，代码完全符合它应该做的事情。但是在某些工作表中，我已经包含了图片或图表，而这些图片或图表未正确粘贴在Excel中。（仅在powerpoint幻灯片中复制空白图片）。现在我想制作一个使用我来自cell＆＃34; C1＆＃34;的输入的代码。确定是否需要将此幻灯片粘贴为图像或普通粘贴。我试图解决这个问题，但我的代码不断出错。有什么办法可以调整这段代码，以便让它运行起来吗？

2 - 代码现在复制所有工作表，但我希望它从表7开始并从那里继续直到结束。因此跳过前6个工作表。有没有人知道如何在我的VBA中排除这些表？

Sub PrintPPT()
 'Step 1:  Declare variables
      Dim pp As Object
      Dim PPPres As Object
      Dim PPSlide As Object
      Dim xlwksht As Worksheet
      Dim MyRange As String

'Step 2:  Open PowerPoint, add a new presentation and make visible
      Set pp = CreateObject("PowerPoint.Application")
      Set PPPres = pp.Presentations.Add
      pp.Visible = True

'Step 3:  Start the loop through each worksheet
      For Each xlwksht In ActiveWorkbook.Worksheets
      MyRange = xlwksht.Range("A1").Value & ":" & xlwksht.Range("A2").Value
      xlwksht.Range(MyRange).Copy

'Step 4:  Count slides and add new blank slide as next available slide number
'(the number 12 represents the enumeration for a Blank Slide)
      SlideCount = PPPres.Slides.Count
      Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
      PPSlide.Select

'Step 5:  Paste the picture and adjust its position
      PPPres.ApplyTemplate ("C:\Users\Template.potx")

      Pastetype = xlwksht.Range("C1").Value

    ' Pastetype will be "PasteSpecial DataType:=2" for images
    ' Pastetype will be "Paste.Select" for normal

    PPSlide.Shapes.pastetype  '2 = ppPasteEnhancedMetafile          


         'pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
          pp.ActiveWindow.Selection.ShapeRange.Top = 85
          pp.ActiveWindow.Selection.ShapeRange.Left = 7.2
         'pp.ActiveWindow.Selection.ShapeRange.Width = 600

'Step 6:  Add the title to the slide then move to next worksheet
      Next xlwksht

'Step 7:  Memory Cleanup
      pp.Activate
      Set PPSlide = Nothing
      Set PPPres = Nothing
      Set pp = Nothing

End Sub

VBA Excel - Powerpoint导出

0 个答案: