将多个 excel 范围/工作表导入到 powerpoint

Question

我有一个包含 20 张工作表的 excel 工作簿，我正在尝试使用 VBA 将这些 excel 工作表导入到 powerpoint 中。我已经能够编写一段几乎完全符合我需要做的代码，但是我无法找到最后一部分的解决方案。希望你们能帮助我！

我需要从每张纸中选择一个不同的范围（在每张纸的单元格 A1 和 A2 中可见）。

例如，我在单元格 A1“B3”和单元格 A2“D12”中有 Excel 工作表 1，这意味着对于此工作表，VBA 应复制范围 B3:D12。

在下一张表中应该会发生完全相同的情况，但是它应该根据我在该表的单元格 A1 和 A2 中放弃的内容调整其范围。

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

 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
      Dim Cval1 As Variant
      Dim Cval2 As Variant
      Dim Rng1 As Range

 '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:  Set the ranges for the data
      Cval1 = ActiveSheet.Range("A1").Value
      Cval2 = ActiveSheet.Range("A2").Value
      Set Rng1 = ActiveSheet.Range("Cval1 : Cval2")
      MyRange = "Rng1"

 'Step 4:  Start the loop through each worksheet
      For Each xlwksht In ActiveWorkbook.Worksheets
      xlwksht.Select
      Application.Wait (Now + TimeValue("0:00:1"))

 'Step 5:  Copy the range as picture
      xlwksht.Range(MyRange).Copy

 'Step 6:  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 7:  Paste the picture and adjust its position
      PPPres.ApplyTemplate ("C:\Users\Computer\Documents\Templates\Template.potx")
          PPSlide.Shapes.Paste.Select
          pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
          pp.ActiveWindow.Selection.ShapeRange.Top = 80
          pp.ActiveWindow.Selection.ShapeRange.Left = 7.2
          pp.ActiveWindow.Selection.ShapeRange.Width = 600

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

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

 End Sub

Answer 1

如果您想要单元格 A1 和 A2 中的值，则在构建范围时不能将变量放在引号中。

Set Rng1 = ActiveSheet.Range("Cval1 : Cval2")

会给你一个 Rng1 作为 Cval1 : Cval2

Set Rng1 = ActiveSheet.Range(Cval1 & ":" & Cval2)

会给你（从你的例子）Rng1 = B3:D12

这应该就是您所需要的。我还没有测试过，所以可能需要一些 tweeking。

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\Computer\Documents\Templates\Template.potx")
          PPSlide.Shapes.Paste.Select
          pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
          pp.ActiveWindow.Selection.ShapeRange.Top = 80
          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