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

Importing multiple ranges into powerpoint slide from excel

提问by user2082262

I am a novice to macro development. I have a macro, which imports a specific range (B4:J40) in every worksheet into a separate ppt slide as an image on a specific position. This is all fine, what i want to achieve is that this macro should import two ranges (say B4:D40 & E4:J40) from same worksheet on same slide as image on separate positions. Then this loop should continue (as it does now) for every worksheet in current workbook.

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

Following is the code I am currently using:

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

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

Please modify it for me as I have no knowledge of coding languages. Thanks in Advance

请为我修改它，因为我不了解编码语言。提前致谢

回答by 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