從Excel創建PowerPoint電子表格

Question

我正在嘗試轉換和/或加固我的演示文稿。

我在以下網站上找到了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