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!
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…
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!
Olá Reinaldo,
O Tutorial ficou perfeito! Superou às minhas expectativas!! É muito bom encontrar um Blog como o seu, agregou bastante ao meu conhecimento em Excel, e com certeza do muitos outros leitores.
Você com certeza é uma pessoa EXCELente.
Parabéns pelo Tutorial e pelo Blog.
Ambos estão incríveis!
Muito Obrigado!!!
Att,
Vinicius.