从excel导入多个范围到幻灯片幻灯片

Question

我是宏观开发的新手。我有一个宏，它将每个工作表中的特定范围（B4：J40）导入到单独的ppt幻灯片中，作为特定位置上的图像。这一切都很好，我想要实现的是这个宏应该从同一张幻灯片上的相同工作表中导入两个范围（比如B4：D40 & E4：J40），并将它们放在单独的位置上。然后这个循环应该继续（就像现在这样）当前工作簿中的每个工作表。

以下是我目前正在使用的代码：

Sub WorkbooktoPowerPoint() 

    'Step 1: Declare your 
    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: Set the ranges for your data and 
    MyRange = "B4:J25" 

    '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).CopyPicture _ 
    Appearance:=xlScreen, Format:=xlPicture 

    '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 
    PPSlide.Shapes.Paste.Select 
    pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 
    pp.ActiveWindow.Selection.ShapeRange.Top = 65 
    pp.ActiveWindow.Selection.ShapeRange.Left = 7.2 
    pp.ActiveWindow.Selection.ShapeRange.Width = 700 


    '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

Sub WorkbooktoPowerPoint() 

    'Step 1: Declare your variables 
    Dim pp As Object 
    Dim PPPres As Object 
    Dim PPSlide As Object 
    Dim xlwksht As Worksheet 
    Dim MyRange As String 
    Dim MyRange1 As String 'Define another Range 
    Dim MyTitle 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: Set the ranges for your data and title 
    MyRange = "B4:D7" 
    MyRange1 = "E4:J7" 
    '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).CopyPicture Appearance:=xlScreen, Format:=xlPicture 
    '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 
    PPSlide.Shapes.Paste.Select 
    pp.ActiveWindow.Selection.ShapeRange.Align msoAlignTops, True 
    pp.ActiveWindow.Selection.ShapeRange.Top = 65 
    pp.ActiveWindow.Selection.ShapeRange.Left = 7.2 
    pp.ActiveWindow.Selection.ShapeRange.Width = 700 
    'Step 8: Add the title to the slide then move to next worksheet 
    xlwksht.Range(MyRange1).CopyPicture Appearance:=xlScreen, Format:=xlPicture 
    PPSlide.Shapes.Paste.Select 
    pp.ActiveWindow.Selection.ShapeRange.Align msoAlignBottoms, True 
    'You can set the second image prostion here 
    pp.ActiveWindow.Selection.ShapeRange.Top = 765 
    pp.ActiveWindow.Selection.ShapeRange.Left = 7.2 
    pp.ActiveWindow.Selection.ShapeRange.Width = 700 

    Next xlwksht 

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

    End Sub