简体   繁体   中英

Import multiple excel ranges/sheets to powerpoint

I have an excel workbook with 20 sheets and I am trying to import these excel sheets into powerpoint using a VBA. I've been able to compose a piece of code which does almost exactly what I need to do, however I am unable to find the solution for the last part.. Hope you guys can help me out!

From each sheet I need to select a different range (which is visible in cell A1 and A2 of each sheet).

for example from excel sheet 1 I have in cell A1 "B3" and in cell A2 "D12", which means that for this sheet the VBA should copy range B3:D12.

In the next sheet exactly the same should happen, however it should adjust its range based on what I've given up in cell A1 and A2 of that sheet.

My code so far is as follows:

 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

IF you want the values in cell A1 And A2, you can't put the variables in quotes when building your range.

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

Will give you a Rng1 as Cval1 : Cval2

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

Will give you (from your example) Rng1 = B3:D12

This should be all you need. I haven't tested it, so there may be some tweeking needed.

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM