从Excel创建PowerPoint电子表格

Question

我想转换和/或系紧我的演示文稿。

我在下面的website中发现了VBA代码，下面附加了一些我稍加修改的代码。

不幸的是，我无法适合电子表格和演示文稿。

您可以在下面的看到白色区域：

。

不知道你是否有解决我的问题的方法。

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 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 = "B2:BH40" '<<<Change this range 

'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 = 1 
pp.ActiveWindow.Selection.ShapeRange.Left = 1 
pp.ActiveWindow.Selection.ShapeRange.Width = 720 

'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 ppShape As Object 
Dim xlwksht As Worksheet 
Dim MyRange As String 
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 = "B2:BH40" '<<<Change this range 

'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) 

    'Step 7: Paste the picture and adjust its position 
    Set ppShape = PPSlide.Shapes.Paste 
    With ppShape 
     '.ShapeRange.Align msoAlignCenters, True 
     .Top = 0 
     .Left = 0 
     .Width = PPPres.PageSetup.SlideWidth 
     .Height = PPPres.PageSetup.SlideHeight 
    End With 'ppShape 
    '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