我想构建一个将Excel-Data-Sheet与Reporting-Powerpoint-Presentation连接起来的宏。 所以我选择并复制了这个命名范围(“A”)。 然后我想将数据粘贴到Powerpoint中与我的Range(“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粘贴时一样。
任何帮助都会非常感激。
答案 0 :(得分: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
答案 1 :(得分:0)
'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