VBA填充PowerPoint中的表格数据的方法

以下代码由PHP站长网 52php.cn收集自互联网

现在PHP站长网小编把它分享给大家，仅供参考

Populating a Powerpoint Table (Group) with Data from Microsoft Excel using VBA
'Code by Mahipal Padigela
'Open Microsoft Powerpoint,Choose/Insert a Table type Slide(No.4),then double click to add a...
'...Table(3 Cols & 2 Rows) then rename the Table to "Table1",Save and Close the Presentation
'Open Microsoft Excel,add some test data to Sheet1(This example assumes that you have some data in...
'... Rows 1,2 and Columns 1,2,3)
'Open VBA editor(Alt+F11),Insert a Module and Paste the following code in to the code window
'Reference 'Microsoft Powerpoint Object Library' (VBA IDE-->tools-->references)
'Change "strPresPath" with full path of the Powerpoint Presentation created earlier.
'Change "strNewPresPath" to where you want to save the new Presnetation to be created later
'Close VB Editor and run this Macro from Excel window(Alt+F8) 

Dim oPPTApp As PowerPoint.Application
Dim oPPTShape As PowerPoint.Shape
Dim oPPTFile As PowerPoint.Presentation
Dim SlideNum As Integer
Sub PPTableMacro()
    Dim strPresPath As String,strExcelFilePath As String,strNewPresPath As String
    strPresPath = "H:PowerPointPresentation1.ppt"
    strNewPresPath = "H:PowerPointnew1.ppt"
    
    Set oPPTApp = CreateObject("PowerPoint.Application")
    oPPTApp.Visible = msoTrue
    Set oPPTFile = oPPTApp.Presentations.Open(strPresPath)
    SlideNum = 1
    oPPTFile.Slides(SlideNum).Select
    Set oPPTShape = oPPTFile.Slides(SlideNum).Shapes("Table1")
    
    Sheets("Sheet1").Activate
    oPPTShape.Table.Cell(1,1).Shape.TextFrame.TextRange.Text = Cells(1,1).Text
    oPPTShape.Table.Cell(1,2).Shape.TextFrame.TextRange.Text = Cells(1,2).Text
    oPPTShape.Table.Cell(1,3).Shape.TextFrame.TextRange.Text = Cells(1,3).Text
    oPPTShape.Table.Cell(2,1).Shape.TextFrame.TextRange.Text = Cells(2,1).Text
    oPPTShape.Table.Cell(2,2).Shape.TextFrame.TextRange.Text = Cells(2,2).Text
    oPPTShape.Table.Cell(2,3).Shape.TextFrame.TextRange.Text = Cells(2,3).Text
  
    oPPTFile.SaveAs strNewPresPath
    oPPTFile.Close
    oPPTApp.Quit
          
    Set oPPTShape = Nothing
    Set oPPTFile = Nothing
    Set oPPTApp = Nothing
    
    MsgBox "Presentation Created",vbOKOnly + vbInformation
End Sub

以上内容由PHP站长网【52php.cn】收集整理供大家参考研究

如果以上内容对您有帮助，欢迎收藏、点赞、推荐、分享。

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!