将 Excel 到 Powerpoint 的命名范围粘贴到命名形状中 - VBA
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/12186931/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Paste named range from Excel to Powerpoint into named shape - VBA
提问by limfinity
I want to build a macro that connects our Excel-Data-Sheet with our Reporting-Powerpoint-Presentation. So I have this named Range ("A") selected and copied. Then I want to paste the data into a shape in Powerpoint which has the same name as my Range ("A").
我想构建一个宏，将我们的 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
Everything works just fine, except the pasting. When I paste the selection everything is pasted into cell(1, 1).
But I want to copy each cell into a different cell. Like it does when you paste with STRG + V.
一切正常，除了粘贴。当我粘贴选择时，所有内容都粘贴到单元格（1, 1）中。
但我想将每个单元格复制到不同的单元格中。就像使用 STRG + V 粘贴时一样。
Any help would be really appreciated.
任何帮助将非常感激。
回答by Tim Williams
This worked for me (Office 2007)...
这对我有用（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
回答by BrOSs
'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
