导入多个excel范围/表格到powerpoint

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

从每张纸我需要select一个不同的范围（这是在每个表单元格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中的值，则不能在构build范围时将variables放在引号中。

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

会给你一个Rng1作为Cval1：Cval2

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

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

这应该是你需要的一切。 我没有testing过，所以可能需要一些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