从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