EXcel VBA: макрос Excel для создания таблицы в PowerPoint

Мое требование - у меня есть Excel, содержащий некоторые данные. Я хотел бы выбрать некоторые данные из Excel и открыть файл PowerPoint и

Создать таблицу в PowerPoint и заполнить ее данными

Прямо сейчас мне удалось собрать данные из Excel, открыв файл PowerPoint через Excel Код VBA.

Код для открытия PowerPoint из Excel.

    Set objPPT = CreateObject("Powerpoint.application")
    objPPT.Visible = True
    Dim file As String
    file = "C:\Heavyhitters_new.ppt"
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPres = pptApp.Presentations.Open(file)

Теперь, как мне создать таблицу в PowerPoint из Excel и заполнить данные.

Мы будем очень признательны за своевременную помощь.

Заранее спасибо,

6
задан Todd Main 12 March 2011 в 08:04
поделиться

1 ответ

Вот код из http://mahipalreddy.com/vba.htm

''# 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
7
ответ дан 9 December 2019 в 20:38
поделиться
Другие вопросы по тегам:

Похожие вопросы: