Powerpoint VBA
Google
Web www.mahipalreddy.com

 

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

Top

Get Data into a Powerpoint Graph from Microsoft Excel using VBA

'Code by Mahipal Padigela
'Open Microsoft Powerpoint,Choose/Insert a Graph type Slide(No.8), then double click to add a graph and click...
'...outside the graph to close the Datasheet, then rename the Graph to "Mychart",Save and Close the Presentation
'Open Microsoft Excel, add some test data to Sheet1(This example assumes that you have some test data...
'...(numbers between 0-100) in Rows 2,3,4 and Columns B,C,D,E).
'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)
'Reference 'Microsoft Graph 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
Public oGraph As Graph.Chart
Dim SlideNum As Integer

Sub PPGraphMacro()
    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("Mychart")
    Set oGraph = oPPTShape.OLEFormat.Object
    
    Sheets("Sheet1").Activate
    oGraph.Application.DataSheet.Range("A1").Value = Cells(2, 2).Value
    oGraph.Application.DataSheet.Range("A2").Value = Cells(3, 2).Value
    oGraph.Application.DataSheet.Range("A3").Value = Cells(4, 2).Value
    oGraph.Application.DataSheet.Range("B1").Value = Cells(2, 3).Value
    oGraph.Application.DataSheet.Range("B2").Value = Cells(3, 3).Value
    oGraph.Application.DataSheet.Range("B3").Value = Cells(4, 3).Value
    oGraph.Application.DataSheet.Range("C1").Value = Cells(2, 4).Value
    oGraph.Application.DataSheet.Range("C2").Value = Cells(3, 4).Value
    oGraph.Application.DataSheet.Range("C3").Value = Cells(4, 4).Value
    oGraph.Application.DataSheet.Range("D1").Value = Cells(2, 5).Value
    oGraph.Application.DataSheet.Range("D2").Value = Cells(3, 5).Value
    oGraph.Application.DataSheet.Range("D3").Value = Cells(4, 5).Value

'Should you need to access the Graph axes to turn them On/Off or to set ranges etc etc...use this
'   oGraph.HasAxis(xlValue, xlPrimary) = True  ' Shows Y-axis on the graph
'   Set oAxis = oGraph.Axes(xlValue)
'   With oAxis
'       .MinimumScale = 0
'       .MaximumScale = 1.2
'   End With
'   oGraph.HasAxis(xlValue, xlPrimary) = False ' Hides Y-axis on the graph 
'Should you need to access the Graph's Markers to change their Color based on Data at...
'...runtime etc...use this(Not applicable to the graph in this example but to Graphs with Markers like..
'... Bubble, Line etc. Scatter charts)
'    Dim i as Integer
'    For i = 1 To oGraph.SeriesCollection(1).Points.Count
'        If oGraph.Application.DataSheet.Cells(i, 2).Value >= 50 Then
'            oGraph.SeriesCollection(1).Points(i).MarkerBackgroundColorIndex = 3
'            oGraph.SeriesCollection(1).Points(i).MarkerForegroundColorIndex = 3
'        Else
'            oGraph.SeriesCollection(1).Points(i).MarkerBackgroundColorIndex = 6
'            oGraph.SeriesCollection(1).Points(i).MarkerForegroundColorIndex = 6
'        End If
'    Next i 

    oGraph.Application.Update
    oGraph.Application.Quit
  
    oPPTFile.SaveAs strNewPresPath
    oPPTFile.Close
    oPPTApp.Quit
    
    Set oGraph = Nothing
    Set oPPTShape = Nothing
    Set oPPTFile = Nothing
    Set oPPTApp = Nothing
    MsgBox "Presentation Created", vbOKOnly + vbInformation
End Sub

Top

Add Notes(Text) to a Powerpoint slide NotesPage Programatically(from within Powerpoint application)

'Code by Mahipal Padigela
'Open Microsoft powerpoint application and add a Slide
'Open VBA editor(Alt+F11),Insert a Module and Paste the following code in to the code window
'Close VBA Editor and run this Macro from Powerpoint window(Alt+F8) 
Sub AddNotestoPP()
    Dim Sl As Slide
    Dim Sh As Shape
    Dim strNotesPageText As String
  
    strNotesPageText = "Add some text like......Mahipalreddy.com Free Excel Powerpoint" & vbCrLf _
    &  " VBA Source codes also ASP, Sql server, Crystal reports, UML, software " _ 
	&  " engineering, Database design Resources"
    
    Set Sl = ActivePresentation.Slides(1)
    If Sl.NotesPage.Shapes.Count = 0 Then 'If no shapes to take Notes then add a shape first	
        Sl.NotesPage.Shapes.AddShape msoShapeRectangle, 0, 0, 0, 0
        Sh = Sl.NotesPage.Shapes(1)
        Sh.TextFrame.TextRange.Text = strNotesPageText
    Else    'has shapes, so see if they take text
        For Each Sh In Sl.NotesPage.Shapes
            If Sh.HasTextFrame Then
                Sh.TextFrame.TextRange.Text = strNotesPageText
                Exit For
            End If
        Next Sh
    End If
End Sub

Top

 
www.mahipalreddy.com
Terms and Conditions of Use
Copyright 2004 - 2006 Mahipal Padigela. All rights reserved.