Exportar Gráficos para Power Point

Question

Boa tarde, galera!

Estou com uma dúvida: Tenho uma planilha com alguns formulários que está rodando tudo perfeitamente, exceto por um mísero botão!

Este botão, deveria copiar todos os gráficos da planilha e lançá-lo ao Power Point (não é necessário salvar a apresentação depois de ter os gráficos copiados).

Consegui fazer sem problemas um botão para copiar para a área de transferência como imagem, conforme abaixo:

Obs.: São 9 gráficos e gostaria de usar os Options Buttons para selecionar os gráficos que serão exportados para o PPT (as ranges dos gráficos não são necessária) - Incluindo um Option Button, que exportaria todos os 9 gráficos.

            If op11.Value = True Then
            Sheets("Graf_1").CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
            ElseIf op12.Value = True Then
            Sheets("Graf_2").CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
            ElseIf op13.Value = True Then
            Sheets("Graf_3").CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
            ElseIf op14.Value = True Then
            Sheets("Graf_4").CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
            ElseIf op15.Value = True Then
            Sheets("Graf_5").CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
            ElseIf op16.Value = True Then
            Sheets("Graf_6").CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
            ElseIf op17.Value = True Then
            Sheets("Graf_7").CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
            ElseIf op18.Value = True Then
            Sheets("Graf_8").CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
            ElseIf op19.Value = True Then
            Sheets("Graf_9").CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

Alguém poderia me ajudar???

Obrigadoi

---

Obrigado, Everton

Answer 1

Veja como colar um gráfico como imagem no primeiro slide de uma Apresentação chamada Apresentação1:

Sub Exemplo()

    With ThisWorkbook
        Select Case True
            Case op11
                ColarPP .Charts("Graf_1")
            Case op12
                ColarPP .Charts("Graf_2")
            Case op13
                ColarPP .Charts("Graf_3")
            Case op14
                ColarPP .Charts("Graf_4")
            Case op15
                ColarPP .Charts("Graf_5")
            Case op16
                ColarPP .Charts("Graf_6")
            Case op17
                ColarPP .Charts("Graf_7")
            Case op18
                ColarPP .Charts("Graf_8")
            Case op19
                ColarPP .Charts("Graf_9")
        End Select
    End With
    
End Sub

Sub ColarPP(cht As Chart)
    Dim appPP As Object
    Dim pres As Object
    Dim vGráfico As Variant
    
    'Botém objeto Aplicação PowerPoint
    On Error Resume Next
    Set appPP = GetObject(, "PowerPoint.Application")
    If appPP Is Nothing Then Exit Sub
    On Error GoTo 0
    Set pres = appPP.Presentations("Apresentação1.pptx")
        
    cht.ChartArea.Copy
    Set vGráfico = pres.Slides(1).Shapes.PasteSpecial(DataType:=3)
    
    'Ajusta posição do gráfico
    vGráfico.Left = 30
    vGráfico.Top = 30
    
End Sub

Note que alterei a sua estrutura de If para o Select Case, para o código ficar mais legível.

Use as propriedades Left e Top para ajustar a posição do gráfico no slide.

No código, estou supondo que a Apresentação está aberta. Caso queira criá-la em tempo de execução, você poderia usar algo como:

    On Error Resume Next
    Set appPowerPoint = GetObject(, "PowerPoint.Application")
    If appPowerPoint Is Nothing Then
        Set appPowerPoint = CreateObject("PowerPoint.Application")
        appPowerPoint.Visible = True
    End If
    On Error GoTo 0
    Set pres = appPowerPoint.Presentations.Open("c:\exemplo\apresentação.pptx")

Se quiser saber mais sobre boas práticas de instanciação de Aplicações:

http://www.ambienteoffice.com.br/officevba/boas_praticas_para_instanciacao_de_aplicacoes/

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 2

Fala Felipe! Cara, muito obrigado pela atenção... 

Muito provavelmente não soube como usar seu script pois não deu certo... Ao executar a Sub ColaPP nada acontece; o Power Point sequer abre.

Se vc puder me ajudar, segue o link da minha planilha

http://www.4shared.com/file/MIw7_-WI/BD_Perfil_Colaboradores.html?

 

Muito Obrigado

---

Obrigado, Everton

Answer 3

Olá, tudo bem?

 

O PowerPoint não abriu porque, como eu disse na minha resposta:

No código, estou supondo que a Apresentação está aberta. Caso queira criá-la em tempo de execução, você poderia usar algo como:

 

    On Error Resume Next
    Set appPowerPoint = GetObject(, "PowerPoint.Application")
    If appPowerPoint Is Nothing Then
        Set appPowerPoint = CreateObject("PowerPoint.Application")
        appPowerPoint.Visible = True
    End If
    On Error GoTo 0
    Set pres = appPowerPoint.Presentations.Open("c:\exemplo\apresentação.pptx")

 

Se quiser saber mais sobre boas práticas de instanciação de Aplicações:

http://www.ambienteoffice.com.br/officevba/boas_praticas_para_instanciacao_de_aplicacoes/

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 4

Fala Felipe!

Cara, consegui!!!! Muito obrigado...

Não qurendo abusar - mas já abusando - como adciono itens a uma combobox, com determinado range da planilha??

 

abs!!!

---

Obrigado, Everton

Answer 5

Sugiro que faça perguntas diferentes em tópicos diferentes.

 

Se o link a seguir não responder sua pergunta, crie um novo tópico: http://www.ambienteoffice.com.br/excel/vincular_caixa_de_combinacao_a_uma_lista/ (percebi agora que as imagens da página do site estão ilegíveis, estou consertando-as).

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br