Export Data from Access Tables to Tables Existing in PowerPoint Presentation

If you want to copy the value from access to table existing in a PowerPoint Presentation the first thing which we have to do find out -

1 Slide Number

2. Table no ( on that particular slide) like its table 1 or 2, etc on slide no 1 , or 2 ,etc

3. Row No.

4. Col No.

Download Presentation
Access Database


Here is the code-


Sub export_data_from_access_to_powerpt()
' TO FIND OUT TABLE NO , ROW NO, COL NO, ETC
' tools -> refrence select -> Microsoft powerpoint
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim oPS As PowerPoint.Slide
Dim Shp As Object
Dim i, j As Integer
Set PPApp = New PowerPoint.Application
PPApp.Visible = True
' open the sample ppt in which u have already made tables ,etc.
Set PPPres = PPApp.Presentations.Open("C:\Documents and Settings\user\Desktop\acess tutorials\Export Access To Powerpoint.ppt")
For Each oPS In PPPres.Slides
w = 1
' go through all the tables in each slides and find the table no , row no , col no
For Each Shp In oPS.Shapes
' check if the shape is table or not
If Shp.HasTable Then
For i = 1 To Shp.Table.Rows.Count
For j = 1 To Shp.Table.Columns.Count

' "Table " TABLE NO ON THAT SLIDE
' ROW - ROW NO OF CELL

' COL - COLUMN NO OF CELL
Shp.Table.Cell(i, j).Shape.TextFrame.TextRange.Text = "Table " & w & vbCrLf & "Row " & i & vbCrLf & "Col " & j
Next
Next
w = w + 1
End If
Next
Next
End Sub


Once you know the table no , row no , and col no

I have three tables in access database "north","south","west" and I want to export the data from each table to the table already existing in PowerPoint slides.

Access Database

Here is the code-

Option Compare Database

Sub export_data_from_access_to_powerpt_tables()

' tools -> refrence select -> Microsoft powerpoint
Dim RS As DAO.Recordset
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim oPS As PowerPoint.Slide
Set PPApp = New PowerPoint.Application
PPApp.Visible = True
' open the sample ppt in which u have already made tables ,etc.
Set PPPres = PPApp.Presentations.Open("C:\Documents and Settings\user\Desktop\acess tutorials\Export Access To Powerpoint.ppt")

' Slides(2) 2 is slide no
'Shapes(1) 1 is table no on that particluar slide
'Cell(2, 2) 2, 2, is row and column no.
' COPY NORTH TABLE
Set RS = CurrentDb.OpenRecordset("NORTH", dbOpenDynaset)
RS.MoveFirst
Do While Not RS.EOF
For i = 2 To 4
PPPres.Slides(2).Shapes(1).Table.Cell(i, 1).Shape.TextFrame.TextRange.Text = RS.Fields![Rep].Value
PPPres.Slides(2).Shapes(1).Table.Cell(i, 2).Shape.TextFrame.TextRange.Text = RS.Fields![Loc].Value
PPPres.Slides(2).Shapes(1).Table.Cell(i, 3).Shape.TextFrame.TextRange.Text = RS.Fields![Sales].Value
RS.MoveNext
Next
Loop
RS.Close

' COPY SOUTH TABLE
Set RS = CurrentDb.OpenRecordset("SOUTH", dbOpenDynaset)
RS.MoveFirst
Do While Not RS.EOF
For i = 2 To 4
PPPres.Slides(3).Shapes(1).Table.Cell(i, 1).Shape.TextFrame.TextRange.Text = RS.Fields![Rep].Value
PPPres.Slides(3).Shapes(1).Table.Cell(i, 2).Shape.TextFrame.TextRange.Text = RS.Fields![Loc].Value
PPPres.Slides(3).Shapes(1).Table.Cell(i, 3).Shape.TextFrame.TextRange.Text = RS.Fields![Sales].Value
RS.MoveNext
Next
Loop
RS.Close

' COPY WEST TABLE
Set RS = CurrentDb.OpenRecordset("WEST", dbOpenDynaset)
RS.MoveFirst
Do While Not RS.EOF
For i = 2 To 4
PPPres.Slides(4).Shapes(1).Table.Cell(i, 1).Shape.TextFrame.TextRange.Text = RS.Fields![Rep].Value
PPPres.Slides(4).Shapes(1).Table.Cell(i, 2).Shape.TextFrame.TextRange.Text = RS.Fields![Loc].Value
PPPres.Slides(4).Shapes(1).Table.Cell(i, 3).Shape.TextFrame.TextRange.Text = RS.Fields![Sales].Value
RS.MoveNext
Next
Loop
RS.Close
Set PPPres = Nothing
Set PPApp = Nothing
Set RS = Nothing
End Sub