2017-02-27 151 views
1

我想轉換和/或繫緊我的演示文稿。從Excel創建PowerPoint電子表格

我在下面的website中發現了VBA代碼,下面附加了一些我稍加修改的代碼。

不幸的是,我無法適合電子表格和演示文稿。

您可以在下面的看到白色區域:

example

不知道你是否有解決我的問題的方法。

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 

回答

0

這將在同一尺寸調整粘貼形狀幻燈片:

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 
+0

非常感謝您! 此外,我想改變我的PPT的形狀,但它似乎仍然不起作用,並出現錯誤「無效的枚舉值」。試圖谷歌它,但沒有找到正確的答案。 ''第2步:打開PowerPoint,添加一個新的演示文稿,並可見 設置頁=的CreateObject( 「PowerPoint.Application」) 設置PPPres = pp.Presentations.Add PPPres.PageSetup.SlideSize = ppSlideSizeOnScreen 頁。 Visible = True' – Przemek

+0

請花一分鐘時間參觀遊覽:http://stackoverflow.com/tour。嘗試將ppSlideSizeOnScreen替換爲1,因爲您使用的是後期綁定,該變量無法識別。 – R3uK

+0

謝謝!然而,第7步中有錯誤438。問題出在命令'.Height = PPPres.PageSetup.SlideHeigth' – Przemek