|
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
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
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
|