none
Exportar Gráficos para Power Point RRS feed

  • Pergunta

  • 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
    quarta-feira, 26 de outubro de 2011 20:35

Respostas

  • 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
    • Marcado como Resposta almeida.eas terça-feira, 1 de novembro de 2011 19:33
    segunda-feira, 31 de outubro de 2011 12:22
    Moderador

Todas as Respostas

  • 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
    quinta-feira, 27 de outubro de 2011 15:34
    Moderador
  • 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
    domingo, 30 de outubro de 2011 15:28
  • 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
    • Marcado como Resposta almeida.eas terça-feira, 1 de novembro de 2011 19:33
    segunda-feira, 31 de outubro de 2011 12:22
    Moderador
  • 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
    terça-feira, 1 de novembro de 2011 19:33
  • 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
    quarta-feira, 2 de novembro de 2011 12:21
    Moderador