UtterAccess.com
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    
 
   
dhapp
post Mar 13 2013, 03:59 PM
Post#1



Posts: 1,139
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?
CODE
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
    
    rs.MoveLast
    iFound = rs.RecordCount
    r = 2
    rs.MoveFirst
    '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)
                        rs.MoveNext
                        r = r + 1
                    Wend
                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
    ppPres.SlideShowSettings.Run
    'MsgBox "Load another slide"
    Exit Sub
  
err_cmdOLEPowerPoint:
    MsgBox Err.Number & " " & Err.Description
    ' End error handling
    
End Sub
Go to the top of the page
 

Posts in this topic



Custom Search


RSSSearch   Top   Lo-Fi    16th July 2019 - 10:09 AM