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

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
> Formatting A Powerpoint Table Using Access VBA, Office 2007    
post Mar 13 2013, 03:59 PM

Posts: 1,145
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
Start new topic
post Mar 13 2013, 04:04 PM

Access Wiki and Forums Moderator
Posts: 76,081
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

Posts in this topic

Custom Search

RSSSearch   Top   Lo-Fi    24th August 2019 - 11:10 AM