在 Powerpoint 中插入 Excel 内容。错误消息：剪贴板为空或包含不能粘贴到此处的数据

Question

我正在尝试从我的 Excel sheet 复制数据并将其作为图片粘贴到演示文稿中。

通常会显示一条错误消息：

Shapes (unknown member): invalid request. Clipboard is empty or contains data which may not be pasted here.

有时它出现得早一些，有时出现得晚一些，有时它甚至可以工作并且所有幻灯片都已创建。

我的代码如下：

Public Function createPP(workbookName As String, Worksheet As String, title As String) As Boolean
    Dim ppApp As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    Dim ppSlide As PowerPoint.Slide
    Dim counter As Integer
    Dim rng As Range
    Dim lastRow As Integer, lastCol As Integer, lastRow1 As Integer, lastCol1 As Integer
    Dim Worksheet2 As String

    Set ppApp = New PowerPoint.Application
    ppApp.Visible = True
    ppApp.Activate

    Sheets(Worksheet).Select
    lastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    lastCol = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row

    Sheets(Worksheet2).Select
    lastRow1 = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    lastCol1 = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row

    Set ppPres = ppApp.Presentations.Add
    ppPres.ApplyTemplate (ActiveWorkbook.Path & "\HPETheme.thmx")
    Set ppSlide = ppPres.Slides.Add(1, ppLayoutCustom)
    ppSlide.Shapes(1).TextFrame.TextRange = title
    ppSlide.Shapes(2).TextFrame.TextRange = "per SPL per month" '& vbNewLine & "presented by Isabelle Schmiedel"
    ppSlide.Shapes(3).TextFrame.TextRange = "Isabelle Schmiedel"
    x = 2

    For counter = 2 To lastRow - 1
        Set rng = Workbooks(workbookName).Sheets(Worksheet).Range("A" & counter & ":J" & counter + 24)
        Set ppSlide = ppPres.Slides.Add(x, 11)
        ppSlide.Shapes(1).TextFrame.TextRange = Sheets(Worksheet).Cells(counter, 1)
       ppSlide.Select

        rng.Copy

        ppSlide.Shapes.Paste

        counter = counter + 25
        x = x + 1
    Next counter
End Function

Answer 1

而不是

ppSlide.Shapes.Paste

试试这个直接复制 table/range::

ppApp.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"

或者可能：

ppApp.CommandBars.ExecuteMso "PasteSourceFormatting"

如果你更喜欢图片，那么使用这个：

ppApp.CommandBars.ExecuteMso "PasteAsPicture"

解释：

如果由于某种原因无法保留字体大小，您可以这样做

Dim tRow as Long, tCol as Long, shp as Object, tbl as Object, tblCell as Object

Set shp = ppSlide.Shapes(ppSlide.Shapes.Count)
Set tbl = shp.Table
For tRow = 1 to tbl.Rows.Count
    For tCol = 1 to tbl.Columns.Count
        Set tblCell = tbl.Cell(tRow, tCol)
        # Assign each cell the same font size from corresponding cell in Excel range:
        tblCell.Shape.TextFrame.TextRange.Font.Size = rng(tRow, tCol).Font.Size
    Next
Next

您也可以尝试这样的操作，虽然有点老套，但可能比单元格迭代更快：

Set shp = ppSlide.Shapes(ppSlide.Shapes.Count)
shp.Select
While shp.Table.Cell(1,1).TextFrame.TextRange.Font.Size < 12
    ppApp.CommandBars.ExecuteMso "FontSizeIncrease"
Wend

Answer 2

使用下面一个 sld.Shapes.PasteSpecial数据类型：=0

或

sld.Shapes.PasteSpecial数据类型：=ppPasteShape

在 Powerpoint 中插入 Excel 内容。错误消息：剪贴板为空或包含不能粘贴到此处的数据

Insert Excel Content in Powerpoint. Error Message: Clipboard is empty or contains data which may not be pasted here

excel

powerpoint

vba

image

insert