在多张PowerPoint幻灯片上放置多个Excel表格
我把表格从Excel到Powerpoint的范围粘贴起来。
问题是，当我粘贴第一个表时，定位工作正常（.Top和.Left），但我粘贴表后第一个相对于第一个表的位置。
.Top成为桌子左上angular和第一个桌子位置的上边之间的距离（而不是滑块的上边，因为它应该是！），同样的事情发生在左边。（它代表桌子左上angular和第一张桌子左侧之间的距离）。
代码如下：
Sub ExportaraPowerPoint() Dim pptApp As PowerPoint.Application Dim pptPres As PowerPoint.Presentation Dim pptSlide As PowerPoint.Slide Dim pptShape As PowerPoint.Shape Dim excelTable As Excel.Range Dim SlideTitle As String Dim SlideText As String Dim SlideObject As Object Dim pptTextbox As PowerPoint.Shape Dim SlideNumber As String Dim xlTable As PowerPoint.Shape 'Check is PPT is open and create if not On Error Resume Next Set pptApp = GetObject("", "PowerPoint.Application") Err.Clear If pptApp Is Nothing Then Set pptApp = CreateObject(class:="PowerPoint.Application") pptApp.Visible = True pptApp.Activate 'Add presentation Set pptPres = pptApp.Presentations.Add pptPres.PageSetup.SlideSize = ppSlideSizeOnScreen pptPres.ApplyTemplate "c:\Program Files\Microsoft Office\Templates\1033\Blank.potx" 'Assing Tables Set excelTable1 = Worksheets("TDSACI").Range("N246:U259") Set excelTable2 = Worksheets("TDCSD").Range("N215:U223") 'Slide 1: Set pptSlide = pptPres.Slides.Add(1, ppLayoutTitleOnly) excelTable1.Copy pptSlide.Shapes.PasteSpecial (ppPasteDefault) pptSlide.Shapes(2).Width = 670.4 pptSlide.Shapes(2).Height = 292 pptSlide.Shapes(2).Left = 24.4 pptSlide.Shapes(2).Top = 90.4 'Slide 2: Set pptSlide = pptPres.Slides.Add(2, ppLayoutTitleOnly) excelTable2.Copy pptSlide.Shapes.PasteSpecial (ppPasteDefault) pptSlide.Shapes(2).Width = 670.4 pptSlide.Shapes(2).Height = 292 pptSlide.Shapes(2).Left = 24.4 pptSlide.Shapes(2).Top = 90.4 我知道表格总是形状索引号2，所以这不是问题。
根据数字，两个表的位置应该是相同的。
好奇。 如果你注释掉On Error Resume Next ，确保VBE被设置为Break on All Errors in Options ，在第一个Slide 2行放一个中断，你会看到代码在.PasteSpecial行后退出，但没有产生一个错误。 我认为这是因为PowerPoint抱怨幻灯片2不在视图中，所以即使对象似乎粘贴在幻灯片上，粘贴方法也会变得混乱！ 我通过添加GotoSlide方法将其固定在我的演示板（PowerPoint 2016）上：
'Slide 2: Set pptSlide = pptPres.Slides.Add(2, ppLayoutTitleOnly) excelTable2.Copy pptApp.ActiveWindow.View.GotoSlide 2 pptSlide.Shapes.PasteSpecial (ppPasteDefault) pptSlide.Shapes(2).Width = 670.4 pptSlide.Shapes(2).Height = 292 pptSlide.Shapes(2).Left = 24.4 pptSlide.Shapes(2).Top = 90.4
操作PowerPoint视图不需要将对象粘贴到幻灯片，如果代码在PowerPoint VBE中运行，所以我不确定在这种情况下出了什么问题。
如果你想要处理2个以上的范围，下面的代码来replace'Assing tables down 'Assing tables部分的代码可能会更好（也更具可扩展性）。
'Assing Tables Dim excelTables(1) As Range Set excelTables(0) = Worksheets("TDSACI").Range("N246:U259") Set excelTables(1) = Worksheets("TDCSD").Range("N215:U223") For Each myTable In excelTables myTable.Copy With pptPres.Slides.Add(pptPres.Slides.Count + 1, ppLayoutTitleOnly) .Select With .Shapes.PasteSpecial(ppPasteDefault) .Width = 670.4 .Height = 292 .Left = 24.4 .Top = 90.4 End With End With Next