Question

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

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

例如来自excel表1我在单元格A1＆＃34; B3＆＃34;在单元格A2＆＃34; D12＆＃34;中，这意味着对于此工作表，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

这应该是你所需要的。我还没有测试过，所以可能需要一些推文。

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

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

1 个答案: