将命名范围从 Excel 粘贴到 Powerpoint 到命名形状 - VBA答案

【问题标题】：Paste named range from Excel to Powerpoint into named shape - VBA将命名范围从 Excel 粘贴到 Powerpoint 到命名形状 - VBA
【发布时间】：2012-08-29 21:40:57
【问题描述】：

我想构建一个宏，将我们的 Excel-Data-Sheet 与我们的 Reporting-Powerpoint-Presentation 连接起来。所以我选择并复制了这个命名范围（“A”）。然后我想将数据粘贴到 Powerpoint 中与我的范围（“A”）同名的形状中。

Sub SyncWithPPT()

Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptShape As PowerPoint.Shape

Set pptApp = New PowerPoint.Application
pptApp.Visible = msoTrue
Set pptPres = pptApp.presentations.Open("workingPath")

ActiveWorkbook.Names("A").RefersToRange.Select
Selection.Copy
Set pptShape = pptPres.Slides("anySlide").Shapes("A")
pptShape.Table.cell(1, 1).Shape.TextFrame.TextRange.Paste 'Here it won't paste correctly

End Sub

一切都很好，除了粘贴。当我粘贴选择时，所有内容都粘贴到单元格（1、1）中。
但我想将每个单元格复制到不同的单元格中。就像使用 STRG + V 粘贴时一样。

任何帮助将不胜感激。

【问题讨论】：

不幸的是，我删除了旧的大学 Dropbox 帐户，丢失了图像。我从问题中删除了链接，我认为问题所在仍然很清楚。
谢谢。我删除了我的评论。

标签： excel powerpoint shape vba

【解决方案1】：

这对我有用（Office 2007）...

Sub Tester()

    Dim ppt, sld

    'presentation is already open...
    Set ppt = GetObject(, "powerpoint.application")
    Set sld = ppt.activepresentation.slides(1)

    ActiveSheet.Range("A1:B2").Copy

    sld.Shapes(1).Table.Cell(1, 1).Select
    ppt.ActiveWindow.View.Paste

    Set sld = Nothing
    Set ppt = Nothing

End Sub

【讨论】：

【解决方案2】：

'this is how to extract each cell information
'assuming that ppt communication is already done.

Dim n As Integer, j As Integer
Dim ultimaFila As Long    

j = 1 'columna
ultimaFila = Range("A65536").End(xlUp).Row

For n = 1 To ultimaFila

   pptShape.Table.cell(n, j).Value = Application.Workbooks("Book1").Worksheets("Sheet1").Cells(n, j).Value        


Next n

End Sub

【讨论】：