Fala galera, eu encontrei a solução, segue o código comentado caso alguém esteja com a mesma duvida:
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
Application.ScreenUpdating = False 'Executa macro em segundo plano
Sheets("PPT").Select 'Seleciona aba PPT
Call CriarArquivo("PPT") 'Chama função PPT
Exit Sub
Err_Handler: 'Em caso de erro exiba
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
'Salva o arquivo ppt com o nome especificado
sSalvarComo = ThisWorkbook.Path & "ApresentaEficiencia"
iTipoSave = ppSaveAsDefault
'=================================================================================
'=== Copia os gráficos das planilhas ===
'=================================================================================
'Define a planilha que contém os gráficos
Set shComGraf = ThisWorkbook.Worksheets("PPT")
'Verifica se existe gráficos para copiar
If shComGraf.ChartObjects.Count > 0 Then
Dim graf As Integer 'Cria váriavel graf
graf = 1 'Atribui o valor 1 a variavel graf
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
ActiveSheet.Shapes.Range(Array(graf)).Select 'Cria um array com o número
'de graficos onde cada grafico tem um 1 como nome
Selection.Copy 'Copia grafico em questão
'Aqui é feita a cópia do gráfico no Slide
pptSld.Shapes.Paste.Select 'Cola gráfico no slide
'Centraliza grafico no slide
pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoTrue
pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue
End With
graf = graf + 1 'Atribui +1 a variavel graf
Next objChartObject
End If
'=================================================================================
'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
Abraço!
Caso tenha resolvido, não esqueça de clicar na mãozinha ao lado da ferramenta "citar" e fechar o tópico
Postado : 22/06/2015 7:43 am