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 

  

  

  

 

VBA Access - Exportando registros para PARADOX - Exporting Records to Paradox Database

Exportando registros a partir de uma query do MS Office Access para o banco de dados Paradox. Como posso fazê-lo? Utilizo query com dados a partir do MS Office Excel (*.xls), mas hoje quero enviar dados de planilhas que conectei ao MS Access para uso com MS Excel

 15.01.2025 

' Inicializa as variáveis para o nome do relatório, filtro e caminho do Excel

Dim ReportName, ReportFilter, ExcelPath, MSAccess

' Definindo os valores das variáveis

ReportName = "qrySample" ' Nome do relatório

ReportFilter = "RecordID = 1" ' Filtro a ser aplicado ao relatório

ExcelPath = "/Bernardes/" & Session.SessionID & ".xls" ' Caminho do arquivo Excel

' Cria uma instância do Microsoft Access

Set MSAccess = Server.CreateObject("Access.Application")

' Abre o banco de dados Access atual

MSAccess.OpenCurrentDatabase Application("DB")

' Desativa as mensagens de aviso do Access para evitar prompts durante a execução

MSAccess.DoCmd.SetWarnings False

' Abre o relatório no Access com o filtro aplicado

MSAccess.DoCmd.OpenReport ReportName, 2, , ReportFilter

' Exporta o relatório para Excel (formato .xls)

MSAccess.DoCmd.OutputTo 3, ReportName, "MicrosoftExcel(*.xls)", Server.MapPath(ExcelPath), False

' Fecha o relatório depois de exportado

MSAccess.DoCmd.Close 3, ReportName, 2

' Restaura as mensagens de aviso do Access

MSAccess.DoCmd.SetWarnings True

' Fecha o banco de dados Access

MSAccess.CloseCurrentDatabase

' Encerra a aplicação Access

MSAccess.Quit 2

' Libera o objeto MSAccess da memória

Set MSAccess = Nothing

 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 

  

  

  

 

VBA Access - Exportando imagens diretamente para os Slides do Powerpoint - VBA Access: Export Images Directly to PowerPoint Slides

Digamos que temos uma ou mais tabelas cujo o conteúdo seja o caminho (path) de várias de nossas imagens, fotos ou algum conteúdo gráfico. A partir de uma interface simples com botões na nossa aplicação MS Access, podemos criar slides automaticamente enviado nossas fotos, ilustrações e artes para uma apresentação PPT.

Diversos Dashboards contidos em Planilhas do MS Excel, que podem ser abertas, copiadas como imagem dentro do MS Access e automaticamente exportados para o Powerpoint...Usem a imaginação e divirtam-se!

Option Compare Database
Option Explicit

Sub ExToPpt()

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptShape As PowerPoint.Shape  

Set pptApp = New PowerPoint.Application
Set pptPres = pptApp.Presentations.Open("C:\bernardes\ShowA&APresentation.ppt")
cn.Open CurrentProject.Connection
rs.Open Forms!MyTable.RecordSource, cn 

Do Until rs.EOF

Set pptShape = pptSlide.Shapes.AddPicture(rs.Fields("Picturepath").Value)
rs.Move

Next Loop  

rs.close
cn.close 

Set pptSlide = pptPres.Slides.Add 

End Sub

 2015 

Option Compare Database

Option Explicit

' Sub-rotina para exportar imagens do banco de dados para uma apresentação PowerPoint

Sub ExToPpt()

    ' Declaração de variáveis

    Dim cn As New ADODB.Connection          ' Objeto de conexão com o banco de dados

    Dim rs As New ADODB.Recordset           ' Objeto de conjunto de registros (Recordset) para armazenar os dados

    Dim pptApp As PowerPoint.Application    ' Objeto PowerPoint.Application para interagir com o PowerPoint

    Dim pptPres As PowerPoint.Presentation ' Objeto PowerPoint.Presentation para manipular a apresentação

    Dim pptSlide As PowerPoint.Slide        ' Objeto PowerPoint.Slide para manipular slides da apresentação

    Dim pptShape As PowerPoint.Shape        ' Objeto PowerPoint.Shape para adicionar imagens ao slide

    Dim strSQL As String                    ' Variável para armazenar a consulta SQL para buscar os dados da tabela

    ' Inicia o aplicativo PowerPoint

    Set pptApp = New PowerPoint.Application

    ' Abre a apresentação existente

    On Error GoTo ErrorHandler

    Set pptPres = pptApp.Presentations.Open("C:\bernardes\ShowA&APresentation.ppt")

    ' Abre a conexão com o banco de dados Access

    cn.Open CurrentProject.Connection

    ' Define a consulta SQL a ser usada para recuperar os dados da tabela/formulário

    strSQL = "SELECT Picturepath FROM " & Forms!MyTable.RecordSource

    ' Abre o Recordset com os dados da tabela

    rs.Open strSQL, cn

    ' Verifica se o Recordset contém dados antes de continuar

    If Not rs.EOF Then

        ' Loop para percorrer cada registro do Recordset

        Do Until rs.EOF

            ' Adiciona a imagem do banco de dados ao slide do PowerPoint

            Set pptSlide = pptPres.Slides.Add(pptPres.Slides.Count + 1, ppLayoutText) ' Adiciona um novo slide

            Set pptShape = pptSlide.Shapes.AddPicture(rs.Fields("Picturepath").Value, _

                MsoTriState.msoFalse, MsoTriState.msoCTrue, 100, 100, -1, -1) ' Adiciona a imagem ao slide

            rs.MoveNext ' Move para o próximo registro

        Loop

    Else

        MsgBox "Nenhuma imagem encontrada na tabela.", vbExclamation, "Aviso"

    End If

    ' Fecha o Recordset e a conexão com o banco de dados

    rs.Close

    cn.Close

    ' Libera os objetos PowerPoint

    pptPres.Save ' Salva a apresentação

    pptPres.Close ' Fecha a apresentação

    pptApp.Quit ' Fecha o PowerPoint

    ' Libera os objetos

    Set pptShape = Nothing

    Set pptSlide = Nothing

    Set pptPres = Nothing

    Set pptApp = Nothing

    Set rs = Nothing

    Set cn = Nothing

    Exit Sub ' Sai da sub-rotina sem erros

ErrorHandler:

    ' Manipulação de erros para garantir que os objetos sejam liberados corretamente

    MsgBox "Erro: " & Err.Description, vbCritical, "Erro"

    On Error GoTo 0 ' Desativa o manipulador de erros

    ' Libera objetos em caso de erro

    Set pptShape = Nothing

    Set pptSlide = Nothing

    Set pptPres = Nothing

    Set pptApp = Nothing

    Set rs = Nothing

    Set cn = Nothing

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