请选择 进入手机版 | 继续访问电脑版
查看: 200|回复: 0

[.NET开发] VBA填充PowerPoint中的表格数据的方法

3万

主题

3万

帖子

10万

积分

管理员

Rank: 9Rank: 9Rank: 9

积分
100197
发表于 2015-11-23 17:52:03
VBA填充PowerPoint中的表格数据的方法
                   
            
  1. Populating a Powerpoint Table (Group) with Data from Microsoft Excel using VBA
  2. 'Code by Mahipal Padigela
  3. 'Open Microsoft Powerpoint,Choose/Insert a Table type Slide(No.4), then double click to add a...
  4. '...Table(3 Cols & 2 Rows) then rename the Table to "Table1", Save and Close the Presentation
  5. 'Open Microsoft Excel, add some test data to Sheet1(This example assumes that you have some data in...
  6. '... Rows 1,2 and Columns 1,2,3)
  7. 'Open VBA editor(Alt+F11),Insert a Module and Paste the following code in to the code window
  8. 'Reference 'Microsoft Powerpoint Object Library' (VBA IDE-->tools-->references)
  9. 'Change "strPresPath" with full path of the Powerpoint Presentation created earlier.
  10. 'Change "strNewPresPath" to where you want to save the new Presnetation to be created later
  11. 'Close VB Editor and run this Macro from Excel window(Alt+F8)
  12. Dim oPPTApp As PowerPoint.Application
  13. Dim oPPTShape As PowerPoint.Shape
  14. Dim oPPTFile As PowerPoint.Presentation
  15. Dim SlideNum As Integer
  16. Sub PPTableMacro()
  17.     Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String
  18.     strPresPath = "H:\PowerPoint\Presentation1.ppt"
  19.     strNewPresPath = "H:\PowerPoint\new1.ppt"
  20.    
  21.     Set oPPTApp = CreateObject("PowerPoint.Application")
  22.     oPPTApp.Visible = msoTrue
  23.     Set oPPTFile = oPPTApp.Presentations.Open(strPresPath)
  24.     SlideNum = 1
  25.     oPPTFile.Slides(SlideNum).Select
  26.     Set oPPTShape = oPPTFile.Slides(SlideNum).Shapes("Table1")
  27.    
  28.     Sheets("Sheet1").Activate
  29.     oPPTShape.Table.Cell(1, 1).Shape.TextFrame.TextRange.Text = Cells(1, 1).Text
  30.     oPPTShape.Table.Cell(1, 2).Shape.TextFrame.TextRange.Text = Cells(1, 2).Text
  31.     oPPTShape.Table.Cell(1, 3).Shape.TextFrame.TextRange.Text = Cells(1, 3).Text
  32.     oPPTShape.Table.Cell(2, 1).Shape.TextFrame.TextRange.Text = Cells(2, 1).Text
  33.     oPPTShape.Table.Cell(2, 2).Shape.TextFrame.TextRange.Text = Cells(2, 2).Text
  34.     oPPTShape.Table.Cell(2, 3).Shape.TextFrame.TextRange.Text = Cells(2, 3).Text
  35.   
  36.     oPPTFile.SaveAs strNewPresPath
  37.     oPPTFile.Close
  38.     oPPTApp.Quit
  39.          
  40.     Set oPPTShape = Nothing
  41.     Set oPPTFile = Nothing
  42.     Set oPPTApp = Nothing
  43.    
  44.     MsgBox "Presentation Created", vbOKOnly + vbInformation
  45. End Sub
复制代码


回复

使用道具 举报