Excel Copiar imagens do excel para o powerpoint

[DECOVIOTI]

Olá Pessoal

Eu tenho uma pasta de trabalho com 11 planilhas e em cada uma  dessas planilhas eu tenho uma imagem de um gráfico.

Eu gostaria de ter um vba macro que copie e cole uma de cada imagem em um novo slide em uma nova apresentação de power point.

Você poderia me ajudar?

[AfonsoMira]

@DECOVIOTI Boas tudo bem,

Veja se este código lhe ajuda.  

Sub CriarPowerPoint()

 'Adicione a referencia Microsoft PowerPoint X.0 Object Library:
    '1. Va a Tools no menu do VBA
    '2. Clique em referencias
    '3. Desça um pouco até encontrar "Microsoft PowerPoint X.0 Object Library", marque a caixa e clique Okay
 
    'Primeiro declaramos as variaveis
        Dim newPowerPoint As PowerPoint.Application
        Dim activeSlide As PowerPoint.Slide
        Dim cht As Excel.ChartObject
        
    'Desativa o update de ecrã
    Application.ScreenUpdating = False
     
     'Verificamos se não existem powerPoints abertos
        On Error Resume Next
        Set newPowerPoint = GetObject(, "PowerPoint.Application")
        On Error GoTo 0
     
    'Criamos um novo powerpoint
        If newPowerPoint Is Nothing Then
            Set newPowerPoint = New PowerPoint.Application
        End If
    'Criamos a apresentação no powerPoint
        If newPowerPoint.Presentations.Count = 0 Then
            newPowerPoint.Presentations.Add
        End If
     
    'Mostra o PowerPoint
        newPowerPoint.Visible = True
    
    'Conta Abas
    For i = 1 To 11
    
    'Loop por todos os gráficos da folha e cola os no PowerPoint
        For Each cht In Sheets(i).ChartObjects
        
        'Adiciona um novo slide onde vai colar o gráfico
            newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutTitleOnly
            newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
            Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
                
        'Copia o gráfico e coloa no PowerPoint
            cht.Select
            ActiveChart.ChartArea.Copy
            activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
    
        'Deixa o título do slide igual ao título do gráfico
            activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
        'Alinha título do slide ao centro
            activeSlide.Shapes(1).TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
            
        'ajusta as posições do gráfico no slide
            newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15
            newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125
        
            activeSlide.Shapes(2).Width = 600
            activeSlide.Shapes(2).Left = 200
            
        Next
    Next i
    
    'Ativa o update de ecrã
    Application.ScreenUpdating = True
     
    Set activeSlide = Nothing
    Set newPowerPoint = Nothing
     
End Sub

 

Ps. Tem que adicionar o "Microsoft PowerPoint X.0 Object Library" nas referencias do VBA.