✔ Programação GLOBAL®: VBA Access: Exportando dados da query para Slides PPT

VBA Access: Exportando dados da query para Slides PPT

Exporte o conteúdo de suas queries diretamente para o MS Office Powerpoint.

Private Sub BtnExportData_Click()
    ' Author:                 Date:               Contact:
    ' André Bernardes        28/05/2009  08:03    bernardess@gmail.com
    '
    Dim db As Database, rs As  Recordset
    Dim ppObj As PowerPoint.Application
    Dim ppPres As  PowerPoint.Presentation
    Dim nQuery As String

    On Error GoTo  err_cmdOLEPowerPoint

    Let nQuery = "qry_CHART"

    ' Open up a  recordset on the Employees table.
    Set db = CurrentDb
    Set rs =  db.OpenRecordset(nQuery, dbOpenDynaset)

    ' Open up an instance of  Powerpoint.
    Set ppObj = New PowerPoint.Application
    Set ppPres =  ppObj.Presentations.Add

    ' Setup the set of slides and populate them  with data from the
    ' set of records.
    With ppPres
        While  Not rs.EOF
            With .Slides.Add(rs.AbsolutePosition + 1,  ppLayoutTitle)
                Let .Shapes(1).TextFrame.TextRange.Text =  "A&A - In Any Place"
                Let .SlideShowTransition.EntryEffect  = ppEffectFade

                With .Shapes(2).TextFrame.TextRange
                     Let .Text = CStr(rs.Fields("Names").Value)
                     Let .Characters.Font.Color.RGB = RGB(255, 0, 255)
                    Let  .Characters.Font.Shadow = True
                End With
           
                 With .Shapes(3).TextFrame.TextRange
                    Let  .Text = CStr(rs.Fields("Mails").Value)
                    Let  .Characters.Font.Color.RGB = RGB(255, 0, 255)
                    Let  .Characters.Font.Shadow = True
                End With

                 .Shapes(1).TextFrame.TextRange.Characters.Font.Size = 50
            End  With

            rs.MoveNext
        Wend
    End With

    '  Run the show.
    ppPres.SlideShowSettings.Run

    Exit  Sub

err_cmdOLEPowerPoint:
    MsgBox Err.Number & " " &  Err.Description
End Sub

André Luiz Bernardes A&A - WORK, DON´T PLAY! http://al-bernardes.sites.uol.com.br/ bernardess@gmail.com