Usuário com melhor resposta
Exportar Gráficos para Power Point

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
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
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 -
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 -
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
-
-
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