在单独的 PowerPoint 幻灯片上放置多个 Excel 个表格

Question

我正在将 Excel 到 Powerpoint 的范围粘贴为表格。

问题是当我粘贴第一个 table 时，定位工作正常（.Top 和 .Left）但是我在第一个之后粘贴的 tables 相对于第一个定位table.

.Top 成为 table 的左上角和第一个 table 位置的上边之间的距离（不是到幻灯片的上边，因为它应该是！）同样的事情也发生在 .Left 上（它表示 table 的左上角和第一个 table 的左侧之间的距离）。

代码如下：

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\Templates33\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

我知道 table 始终是形状索引号 2，所以这不是问题。

根据数字，两个table的位置应该是一样的。

Answer 1

很好奇。如果您注释掉 On Error Resume Next，请确保在 Options[=] 中将 VBE 设置为 Break on All Errors 18=]，在第一个 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 VBE 中的代码是运行，则无需操作 PowerPoint 视图即可将对象粘贴到幻灯片，因此我不确定在这种情况下出了什么问题。

Answer 2

如果您希望处理 2 个以上的范围，则以下用于替换 '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

在单独的 PowerPoint 幻灯片上放置多个 Excel 个表格

Positioning multiple Excel tables on separate PowerPoint slides

excel

powerpoint

vba