Vba 从excel将多个范围导入powerpoint幻灯片

我是宏观开发的新手。我有一个宏，它将每个工作表中的特定范围（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

---

请为我修改它，因为我没有编码语言的知识。提前感谢

亲爱的Siddharth Rout，我有您建议的格式的代码，但我希望它能导入多个范围，而不是已经导入的同一范围。谢谢，我正在编写你的代码，并准备好了代码。我在测试代码时迟到了@淘淘已经发布了一个答案，所以我想我将不得不放弃我写的代码。试试那个代码，如果它对你不起作用，我会把答案贴出来。顺便问一下，您想将宽度保持在

700

；）吗？这是我在测试代码时意识到的…非常感谢Taotao，这是一个很大的帮助

    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