X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
   Reply to this topicStart new topic
> Formatting A Powerpoint Table Using Access VBA, Office 2007    
post Mar 13 2013, 03:59 PM

Posts: 1,197
Joined: 17-November 03
From: Hamburg, NY

I've written the code below which takes the data from a query and creates a PPt slide showing the data in a table
The data part works exactly the way I need, but I can't get it to format the way I want.
For instance the line .AddTable(iFound, 5, 10, 10, 288, 216)
should make a table that follows these parameter: .AddTable(Rows, Columns, Left, Top, Width, Height)
But the chart comes out exactly the same no matter how I change the Left, Top, Width and Height
The Rows and Column do work properly.
Currently I am using .AddTable(iFound, 5, 0, 0, 0, 0) to create the table.
Oreally want to change the font size and row height and have been trying many different ways of doing it, but no joy.
The intellisense helps me know when I have something that is not buggy, but nothing so far has actually changed the font size or row height
Can any one suggest what the syntax to try and very importantly where it should be put?
Sub cmdPower2()
    Dim db As Database, rs As Recordset
    Dim ppObj As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    Dim iFound As Integer
    Dim cl As Cell
    Dim rw As Row
    Dim r As Integer
    Dim c As Integer
    Dim lLastProject As Long
    lLastProject = 0
    On Error GoTo err_cmdOLEPowerPoint
    ' Open up a recordset on the Employees table.
    Set db = CurrentDb
    Set rs = db.OpenRecordset("quProjectsInProgress", dbOpenDynaset)
    'quProjectsInProgress:  ClName-0    ProjectID-1     Department-2    CrewLead-3      PcentComplete-4
    ' Open up an instance of Powerpoint.
    Set ppObj = New PowerPoint.Application
    Set ppPres = ppObj.Presentations.Add
    iFound = rs.RecordCount
    r = 2
    'Setup the set of slides and populate them with data from the set of records.
    With ppPres
        With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle)
            With .Shapes _
                .AddTable(iFound, 5, 0, 0, 0, 0)
                '.AddTable(Rows, Columns, Left, Top, Width, Height)
                '.AddTable(iFound, 5, 10, 10, 288, 216)
                With .Table
                    'Format the first Row
                    'Color the first row
                    For Each cl In .Rows(1).Cells
                        cl.Shape.Fill.ForeColor.RGB = RGB(50, 125, 0)
                    Next cl
                    'Size the columns.
                    .Columns(1).Width = 200
                    .Columns(2).Width = 75
                    .Columns(3).Width = 150
                    .Columns(4).Width = 125
                    .Columns(5).Width = 75
                    'Populate the Header row
                    .Cell(1, 1).Shape.TextFrame.TextRange.Text = "Client"
                    .Cell(1, 2).Shape.TextFrame.TextRange.Text = "Project"
                    .Cell(1, 3).Shape.TextFrame.TextRange.Text = "Dept."
                    .Cell(1, 4).Shape.TextFrame.TextRange.Text = "Lead"
                    .Cell(1, 5).Shape.TextFrame.TextRange.Text = "% Done"
                End With
                'Populate the data rows.
                With .Table
                    While Not rs.EOF
                        For c = 1 To 5
                            If r > iFound Then Exit For
                             Select Case c
                                Case 1, 2
                                    If rs.Fields(1) <> lLastProject Then
                                        .Cell(r, c).Shape.TextFrame.TextRange.Text = rs.Fields(c - 1)
                                    End If
                                Case Else
                                        .Cell(r, c).Shape.TextFrame.TextRange.Text = rs.Fields(c - 1)
                            End Select
                        Next    'c column
                        lLastProject = rs.Fields(1)
                        r = r + 1
                End With
            End With
            .SlideShowTransition.EntryEffect = ppEffectBlindsVertical
        End With
    End With
    'End If
    ' Run the show.
    ppPres.SaveAs "C:\Documents and Settings\rickkaz\DesktopDashboardTry", ppSaveAsPresentation
    'MsgBox "Load another slide"
    Exit Sub
    MsgBox Err.Number & " " & Err.Description
    ' End error handling
End Sub
Go to the top of the page
post Mar 13 2013, 04:04 PM

UA Moderator
Posts: 78,627
Joined: 19-June 07
From: SunnySandyEggo

Hi Doug,
The AddTable method doesn't seem to have anything to do with Fonts. See if this helps: Font Object.
Just my 2 cents... 2cents.gif
Go to the top of the page
post Mar 13 2013, 05:14 PM

Posts: 1,197
Joined: 17-November 03
From: Hamburg, NY

Yes, I know that the AddTable method doesn't have anything to do with fonts. I referred to that method to show that not all of the arguments get passed.

I think it is strange that .AddTable(iFound, 5, 10, 10, 288, 216) and .AddTable(iFound, 5, 0, 0, 0, 0) produce the exact same result.
The hope was that someone might understand why the row and columns do work and the other three arguments don't.
The reference that you supplied (Thank you) is problematic. Here's the sample it provides:
With ActivePresentation.Slides(1).Shapes.Title _
    .Text = "Volcano Coffee"
    With .Font
        .Italic = True
        .Name = "Palatino"
        .Color.RGB = RGB(0, 0, 255)
    End With
End With
I think it is code that can be used within PowerPoint since it references ActivePresentation.Slide(1). My code is being executed from within Access.
Also this code refers to .TextFrame but I am trying to modify the cells of a table, not a textframe.
Go to the top of the page
post Apr 16 2013, 05:03 PM

Posts: 1
Joined: 16-April 13

Hi - was wondering if you ever figured out how to format the font in your Access generated PowerPoint table??
figured out how to apply a table fill and boarder in one shot. I found a powerpoint macro that prints (in debug window) the current style of a formatted table (fill and boarder). Partial code below is for white fill and black boarder (see red code).
With pptPres With .Slides.Add(pptPres.Slides.Count + 1, ppLayoutTitle) '2nd Withstatement
.ApplyTemplate (pptfile) 'apply powerpoint template file selected by user
'.Shapes.AddTable 23, 20, 230, 60
.Shapes.AddTable (ABSFindRecordCount + COMMFindRecordCount + InstrumFindRecordCount + MDIOCFindRecordCount + RangesFindRecordCount + SBSFindRecordCount + TSSFindRecordCount + 1), 6, 3, 90, 300, 60 'rows+header, columns,horizontal center, vertical center, width, height
'Format table columns
lngShapeID = lngShapeID + 1
With .Shapes(lngShapeID).Table
.Columns(1).Width = 187
.Columns(2).Width = 85
.Columns(3).Width = 85
.Columns(4).Width = 85
.Columns(5).Width = 85
.Columns(6).Width = 187

'format table, no fill, black boarder
.ApplyStyle ("{5940675A-B579-460E-94D1-54222C63F5DA}")

'Write table header from Access table
lngX = 1
lngY = 1
While Not RSpptblHeader.EOF
.Cell(lngY, lngX).Shape.TextFrame.TextRange.Text = RSpptblHeader.Fields("Header").Value
lngX = lngX + 1

'..... ABS START ................................................................................
If ABSFindRecordCount = 0 Then GoTo CHECKCOMM Else
'Fill table with Program, Meeting, Location ABS column
lngX = 1
lngY = lngY + 1 'next row
.Cell(lngY, lngX).Shape.TextFrame.TextRange.Text = "ABS" 'Write ABS sub-header
lngY = lngY + 1 'next row
'Write ABS data from Access query
While Not RSTravelSch_DTRI_ABS_Query.EOF
.Cell(lngY, lngX).Shape.TextFrame.TextRange.Text = RSTravelSch_DTRI_ABS_Query.Fields("Expr1").Value
lngY = lngY + 1
Please let me know
Go to the top of the page
post Apr 16 2013, 06:24 PM

Posts: 1,197
Joined: 17-November 03
From: Hamburg, NY

Yes I solved my problems.
I have figured out all of the formatting that I was looking for, both within and outside of the tables.
I got the slide background to show the various saved ppt templated.
I even go the presentation to loop.
If you want to see my code, let me know and I will post it.
Go to the top of the page
post Dec 21 2013, 10:12 AM

Posts: 1
Joined: 10-September 09

I would greatly appreciate it if you would post your final solution. This is something I need to accomplish quickly and hopefully your pain can save me some pain.
Go to the top of the page
post Dec 31 2013, 05:35 PM

Posts: 16
Joined: 26-April 06

Recently started wading into the murky world of PowerPoint and Just spotted this post.
Oalso would very much like to see what you came up with.
Go to the top of the page
post Feb 13 2014, 09:59 AM

Posts: 1
Joined: 30-October 09

Was a solution for this issue ever posted? If not, could you share how you solved it.
Go to the top of the page

Custom Search

RSSSearch   Top   Lo-Fi    7th August 2020 - 06:51 AM