E aí pessoal! Tudo Excelente com vocês?

Eu já estava com saudades de escrever para meus queridos leitores. Mas, permita-me compartilhar com vocês algo que me alegra bastante: estou concluindo minha graduação em Ciências da Computação neste final de ano!!!

Isso é muito bom. Me faz lembrar de toda a minha trajetória para alcançar essa meta, onde houveram bons momentos e outros nem tanto, mas que valorizaram imensamente essa conquista.

É claro que com essa correria toda, tive que me ausentar um pouco aqui do blog, pois consome muito tempo, vocês nem imaginam!!! Mas, agora, minha cabeça já está cheia de idéias novas e aguardem novidades bem legais!!!

 

Enfim, vamos ao que interessa, não é mesmo?!!

 

Recentemente, recebi de um leitor, um pedido de ajuda e uma sugestão a respeito de uma macro para automatizar a criação de gráficos do Excel diretamente para o PowerPoint. A necessidade do projeto seria gerar um gráfico para cada situação em uma apresentação individual do PowerPoint, salvando em arquivos distintos numa pasta específica do computador. Já mostrei aqui no blog como salvar cada aba (planilha) em arquivos separados numa pasta do seu computador, mas nesse caso agora ensinarei como salvar cada gráfico em ppt (PowerPoint). E de bônus, vou mostrar como salvar em PDF (Adobe Acrobat) também!

Aproveitem o tutorial!

exportando-graficos-do-excel-para-o-power-point-ppt-01

Introdução

Bem, partirei do princípio que você já tenha sua pasta de trabalho do Excel com suas planilhas contendo seus gráficos já criados. Não será objetivo deste tutorial ensinar como criar os gráficos, abordei isso em outro artigo.

É comum colocarmos gráficos como objetos dentro de uma planilha, porém é bom saber que também existe a possibilidade de inserir um gráfico como uma aba específica e independente na pasta de trabalho. Estou falando isso porque a maneira como faremos referência para cada caso distingue-se um pouco, ok!

A primeira coisa que faremos para construir a macro é adicionar a referência a biblioteca do PowerPoint ao projeto. Lembram como fazer isso?

Abram o editor VBA (ALT+F11) e cliquem em Ferramentas > Referências…

exportando-graficos-do-excel-para-o-power-point-ppt-02

Construindo a Macro para exportar os gráficos

Adicionem um Módulo ao projeto e incluam o código a seguir. A princípio mostrarei apenas a primeira parte, que transporta cada gráfico para uma única apresentação PowerPoint ou arquivo PDF.

Option Explicit
'Você precisa incluir a referência (Ferramentas | Referências) para a biblioteca Microsoft PowerPoint Object Library

Sub CriarPPT()
On Error GoTo Err_Handler

    Call CriarArquivo("PPT")

Exit Sub
Err_Handler:
    MsgBox Err.Description, vbExclamation
End Sub

Sub CriarPDF()
On Error GoTo Err_Handler

    Call CriarArquivo("PDF")

Exit Sub
Err_Handler:
    MsgBox Err.Description, vbExclamation
End Sub

Sub CriarArquivo(ByVal sSalvarTipo As String)
Dim pptApp                  As PowerPoint.Application
Dim pptPres                 As PowerPoint.Presentation
Dim pptSld                  As PowerPoint.Slide
Dim shComGraf               As Worksheet
Dim objChartObject          As ChartObject
Dim objChart                As Chart
Dim iContadorSlide          As Long
Dim sSalvarComo             As String
Dim iTipoSave               As Integer

    'Cria o Powerpoint
    Set pptApp = New PowerPoint.Application
    pptApp.Visible = msoTrue

    'Cria o novo arquivo do Power Point, ou seja, a Apresentação
    Set pptPres = pptApp.Presentations.Add
    Set pptPres = pptApp.ActivePresentation

    'Define o modo de visualização
    'pptApp.ActiveWindow.ViewType = ppViewSlide

    iContadorSlide = 0
    sSalvarComo = ThisWorkbook.Path & "\ExemploExportarGrafico"
    Select Case sSalvarTipo
        Case "PDF"
            iTipoSave = ppSaveAsPDF
        Case Else       '"PPT"
            iTipoSave = ppSaveAsDefault
    End Select

    '=================================================================================
    '===   Copia os gráficos das planilhas                                         ===
    '=================================================================================

    'Define a planilha que contém os gráficos
    Set shComGraf = ThisWorkbook.Worksheets("Plan1")

    'Verifica se existe gráficos para copiar
    If shComGraf.ChartObjects.Count > 0 Then
        For Each objChartObject In shComGraf.ChartObjects
            iContadorSlide = iContadorSlide + 1
            Set objChart = objChartObject.Chart
            Set pptSld = pptPres.Slides.Add(iContadorSlide, 12)
            pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
            With objChart
                'Copia o gráfico como figura
                objChart.CopyPicture xlScreen, xlBitmap, xlScreen
                'Aqui é feita a cópia do gráfico no Slide
                pptSld.Shapes.Paste.Select
                pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoTrue
                pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue
            End With
        Next objChartObject
    End If

    '=================================================================================

    '=================================================================================
    '===   Copia os gráficos criados como Charts                                   ===
    '=================================================================================

    'Busca os gráficos criados em planilhas separadas do tipo Chart
    For Each objChart In ActiveWorkbook.Charts
        iContadorSlide = iContadorSlide + 1
        Set pptSld = pptPres.Slides.Add(iContadorSlide, 12)
        pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
        With objChart
            'Copia o gráfico como figura
            .CopyPicture xlScreen, xlBitmap, xlScreen
            'Aqui é feita a cópia do gráfico no Slide
            pptSld.Shapes.Paste.Select
            pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoTrue
            pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue
        End With
    Next objChart

    '=================================================================================

    'Salva apresentação PowerPoint application
    pptPres.SaveAs sSalvarComo, iTipoSave

    'Encerra aplicativo PowerPoint
    pptPres.Close
    pptApp.Quit

    shComGraf.Range("A1").Select

    Set shComGraf = Nothing
    Set objChart = Nothing
    Set pptSld = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing

    MsgBox "Processo concluído", vbInformation

End Sub

 

Explicando alguns pontos do código

A maior parte do código já está comentado nele próprio. Vou destacar apenas algumas informações importantes.

A partir da linha 60, o loop percorre todos os gráficos que existam na planilha, o copiam e colam como figura no slide que foi adicionado à apresentação. Percebam que a cada iteração do laço For…Next, um novo slide é adicionado.

Para fazer a exportação dos gráficos independentes, a partir da linha 87, o loop percorre todos os objetos do tipo Chart presentes na pasta de trabalho (Workbook). Então, dentro do laço o processo de transporte é similar.

 

Para executar a macro é só chamar as rotinas CriarPPT() ou CriarPDF(), para gerar os gráficos em apresentações PowerPoint ou arquivos em PDF, respectivamente.

Dependendo do tamanho ou quantidade de gráficos, o processo pode demorar um pouco, é claro que ainda sim, será bem mais rápido do que fazer isso manualmente!!! Viva o VBA! Enquanto ele faz tudo isso, vocês podem tomar um cafezinho, que tal?

 

Criando a macro que gera apresentações individuais para cada gráfico

Essa funcionalidade é muito útil para o caso de sua planilha possuir gráficos dinâmicos. Uma situação em que pode ocorrer isso é, por exemplo, numa lista com diversas empresas ou vendedores.

Para gerar um gráfico de posição para cada um dos envolvidos seria interessante criar relatórios individuais para serem, por exemplo, enviados por email para o destinatário correspondente. Falando nisso, da até pra vocês mesclarem essa macro com outra que ensinei aqui sobre como enviar email diretamente do Excel. ;-)

Pensando nisso, vocês podem desenvolver a seguinte macro. Incluam no mesmo módulo da macro anterior.

Sub CriarUmPPT_PorEmpresa()
On Error GoTo Err_Handler

    Call CriarUmArquivo_PorEmpresa("PPT")

Exit Sub
Err_Handler:
    MsgBox Err.Description, vbExclamation
End Sub

Sub CriarUmPDF_PorEmpresa()
On Error GoTo Err_Handler

    Call CriarUmArquivo_PorEmpresa("PDF")

Exit Sub
Err_Handler:
    MsgBox Err.Description, vbExclamation
End Sub

Sub CriarUmArquivo_PorEmpresa(ByVal sSalvarTipo As String)
Dim pptApp                  As PowerPoint.Application
Dim pptPres                 As PowerPoint.Presentation
Dim pptSld                  As PowerPoint.Slide
Dim shComGraf               As Worksheet
Dim objChartObject          As ChartObject
Dim objChart                As Chart
Dim sSalvarComo             As String
Dim rng                     As Range
Dim rngIntervalo            As Range
Dim iContadorSlide          As Long
Dim iTipoSave               As Integer

On Error GoTo Err_Handler

    'Cria o Powerpoint
    Set pptApp = New PowerPoint.Application
    pptApp.Visible = msoTrue

    'Define a planilha que contém os gráficos
    Set shComGraf = ThisWorkbook.Worksheets("Graf Individuais")
    'Define o range que contém os itens para gerar os relatórios individuais
    Set rngIntervalo = shComGraf.Range("C6:C8")

    Select Case sSalvarTipo
        Case "PDF"
            iTipoSave = ppSaveAsPDF
        Case Else       '"PPT"
            iTipoSave = ppSaveAsDefault
    End Select

    For Each rng In rngIntervalo
        'Troca a empresa para atualizar o gréfico
        rng.Worksheet.Range("H5").Value = rng.Value

        iContadorSlide = 0
        sSalvarComo = ThisWorkbook.Path & "\ExemploExportarGraficoIndividual_" & rng.Value

        'Cria o novo arquivo do Power Point, ou seja, a Apresentação
        Set pptPres = pptApp.Presentations.Add
        Set pptPres = pptApp.ActivePresentation

        If shComGraf.ChartObjects.Count > 0 Then
            For Each objChartObject In shComGraf.ChartObjects
                iContadorSlide = iContadorSlide + 1
                Set objChart = objChartObject.Chart
                Set pptSld = pptPres.Slides.Add(iContadorSlide, 12)
                pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
                With objChart
                    'Copia o gráfico como figura
                    objChart.CopyPicture xlScreen, xlBitmap, xlScreen
                    'Aqui é feita a cópia do gráfico no Slide
                    pptSld.Shapes.Paste.Select
                    pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoTrue
                    pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue
                End With
            Next objChartObject
        End If

        'Salva apresentação PowerPoint application
        pptPres.SaveAs sSalvarComo, iTipoSave

        'Fecha o arquivo ppt
        pptPres.Close

    Next rng

    'Encerra aplicativo PowerPoint
    pptApp.Quit

    shComGraf.Range("A1").Select

    Set shComGraf = Nothing
    Set objChart = Nothing
    Set pptSld = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing

    MsgBox "Processo concluído", vbInformation

Exit Sub
Err_Handler:
    MsgBox Err.Description, vbExclamation
End Sub

 

Explicando alguns pontos do código

O processo não muda muito, o que diferencia da macro anterior é que o loop maior é feito para percorrer cada item da lista, no caso do exemplo, percorre todas as empresas da lista com o objetivo de criar um arquivo para cada empresa e salvá-lo numa pasta específica do computador.

Para executar a macro é só chamar as rotinas CriarUmPPT_PorEmpresa() ou CriarUmPDF_PorEmpresa(), para gerar os gráficos em apresentações PowerPoint ou arquivos em PDF, respectivamente.

 

Bom, então é isso pessoal.

Espero que tenha gostado. Estou deixando o arquivo com a macro para vocês baixarem, ok.

Até a próxima!

 

Antes de efetuar o download do arquivo de exemplo, convido você a socializar conosco.

Escolha uma das opções abaixo. Seguir no twitter, assinar nossa Newsletter...

Isso nos ajuda na divulgação do site e te permite ficar sempre atualizado das novidades. Fico muito grato pela sua colaboração.

Digite seu email:

Você receberá um email para ativar o cadastro, ok!