清华大佬耗费三个月吐血整理的几百G的资源,免费分享!....>>>
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:\PowerPoint\Presentation1.ppt" strNewPresPath = "H:\PowerPoint\new1.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