VBA Access - Exportando dados da query para Slides PPT - Exporting Query Data to PowerPoint Slides

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

 15.01.2025 




Private Sub BtnExportData_Click()

    ' Author: André Bernardes

    ' Date: 28/05/2009

    ' Contact: bernardess@gmail.com

    ' Description: Exporta dados de um conjunto de registros para uma apresentação PowerPoint.

    ' Declaração de variáveis

    Dim db As Database ' Objeto de banco de dados Access

    Dim rs As Recordset ' Conjunto de registros com os dados a serem exportados

    Dim ppObj As PowerPoint.Application ' Objeto PowerPoint.Application para manipulação do PowerPoint

    Dim ppPres As PowerPoint.Presentation ' Objeto PowerPoint.Presentation para criação da apresentação

    Dim nQuery As String ' Nome da consulta (query) a ser utilizada

    ' Tratamento de erros

    On Error GoTo err_cmdOLEPowerPoint

    ' Definindo o nome da consulta

    nQuery = "qry_CHART"

    ' Abrindo o banco de dados e o conjunto de registros com base na consulta

    Set db = CurrentDb

    Set rs = db.OpenRecordset(nQuery, dbOpenDynaset)

    ' Inicializando o aplicativo PowerPoint e criando uma nova apresentação

    Set ppObj = New PowerPoint.Application

    Set ppPres = ppObj.Presentations.Add

    ' Preenchendo os slides com os dados do conjunto de registros

    With ppPres

        ' Loop para percorrer cada registro no conjunto de dados

        While Not rs.EOF

            ' Adicionando um novo slide do tipo título

            With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle)

                ' Definindo o título do slide

                .Shapes(1).TextFrame.TextRange.Text = "A&A - In Any Place"

                ' Definindo o efeito de transição entre os slides

                .SlideShowTransition.EntryEffect = ppEffectFade

                ' Adicionando o nome do empregado no slide

                With .Shapes(2).TextFrame.TextRange

                    .Text = CStr(rs.Fields("Names").Value) ' Colocando o nome no slide

                    .Characters.Font.Color.RGB = RGB(255, 0, 255) ' Cor do texto

                    .Characters.Font.Shadow = True ' Sombras no texto

                End With

                ' Adicionando o e-mail do empregado no slide

                With .Shapes(3).TextFrame.TextRange

                    .Text = CStr(rs.Fields("Mails").Value) ' Colocando o e-mail no slide

                    .Characters.Font.Color.RGB = RGB(255, 0, 255) ' Cor do texto

                    .Characters.Font.Shadow = True ' Sombras no texto

                End With

                ' Ajustando o tamanho da fonte do título

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

            End With

            ' Avançando para o próximo registro

            rs.MoveNext

        Wend

    End With

    ' Inicia a apresentação de slides

    ppPres.SlideShowSettings.Run

    ' Saída da sub-rotina sem erros

    Exit Sub

err_cmdOLEPowerPoint:

    ' Em caso de erro, exibe uma mensagem com o número e a descrição do erro

    MsgBox "Erro: " & Err.Number & " - " & Err.Description

End Sub

 Clique aqui e nos contate via What's App para avaliarmos seus projetos 

Envie seus comentários e sugestões e compartilhe este artigo!

brazilsalesforceeffectiveness@gmail.com

 Série de Livros nut Project 

  

 PUDIM PROJECT