एक्सेल वीबीए: एक्सेल मैक्रो एक PowerPoint

Question

में तालिका बनाने के लिए मेरी आवश्यकता है मेरे पास एक एक्सेल है जिसमें कुछ डेटा है। मैं एक्सेल से कुछ डेटा में एक PowerPoint फ़ाइल और

PowerPoint में टेबल बनाएं डेटा का चयन करें और खोलने के लिए और पॉप्युलेट करने के लिए चाहते हैं यह

अभी मैं एक्सेल एक खोलने से डेटा इकट्ठा करने में सफल रहा है करने के लिए एक्सेल वीबीए कोड के माध्यम से पावरपॉइंट फ़ाइल।

एक्सेल से पावरपॉइंट खोलने के लिए कोड।

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) 

अब मैं Excel से PowerPoint में तालिका कैसे बना सकता हूं और डेटा को पॉप्युलेट कर सकता हूं।

समय पर सहायता की बहुत सराहना की जाएगी।

अग्रिम धन्यवाद,

Answer 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 

Answer 2

कुछ कोड इस एक्सेल-VBA कोई PowerPoint देशी मेज पर एक्सेल से चयनित श्रेणी का निर्यात करता है। यह विलय कोशिकाओं के साथ भी काम करता है।

Sub Export_Range() 

    Dim pp As New PowerPoint.Application 
    Dim ppt As PowerPoint.Presentation 
    Dim sld As PowerPoint.Slide 
    Dim shpTable As PowerPoint.Shape 
    Dim i As Long, j As Long 

    Dim rng As Excel.Range 
    Dim sht As Excel.Worksheet 

    Set rng = Selection 

    pp.Visible = True 
    If pp.Presentations.Count = 0 Then 
     Set ppt = pp.Presentations.Add 
    Else 
     Set ppt = pp.ActivePresentation 
    End If 

    Set sld = ppt.Slides.Add(1, ppLayoutTitleOnly) 
    Set shpTable = sld.Shapes.AddTable(rng.Rows.Count, rng.Columns.Count) 
    For i = 1 To rng.Rows.Count 
     For j = 1 To rng.Columns.Count 
      shpTable.Table.Cell(i, j).Shape.TextFrame.TextRange.Text = _ 
       rng.Cells(i, j).Text 
     Next 
    Next 

    For i = 1 To rng.Rows.Count 
     For j = 1 To rng.Columns.Count 
      If (rng.Cells(i, j).MergeArea.Cells.Count > 1) And _ 
       (rng.Cells(i, j).Text <> "") Then 
       shpTable.Table.Cell(i, j).Merge _ 
       shpTable.Table.Cell(i + rng.Cells(i, j).MergeArea.Rows.Count - 1, _ 
       j + rng.Cells(i, j).MergeArea.Columns.Count - 1) 
      End If 
     Next 
    Next 

    sld.Shapes.Title.TextFrame.TextRange.Text = _ 
     rng.Worksheet.Name & " - " & rng.Address 

End Sub