从Excel创buildPowerPoint电子表格

我正在尝试转换和/或系紧我的演示文稿。

我在下面的网站中find了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