Lembro-me de há alguns, quando criei este Blog específico de VBA, como ainda era incipiente a inter-colaboração de códigos VBA no mercado nacional, bem como a utilização profissional de Dashboards e Scorecards. O desenvolvimento VBA naquela época restringia-se aos expressão "faz-se macros no excel'. Hoje, estamos vivenciando um mercado de desenvolvimento VBA mais maduro, cheio de profissionais competentíssimos (tomara que essa expressão não seja um neologismo), com inúmeras excelentes soluções de desenvolvimento e aplicações de automação. Encontramo-nos amadurecidos e prontos para avançarmos no nosso ciclo de aprimoramento profissional!
O artigo a seguir visa elevar a qualidade da nossa entrega. Enviar o conteúdo das nossas soluções para outros ambientes e interfaces. Das aplicações da suíte MS Office, a editores gráficos para a criação de Info Gráficos e até mesmo a inserção destes em páginas da Web de modo automático (Sharepoint). Mas prá que quero isso? Talvez pergunte-se. Abaixo seguem diversos códigos bem elaborados que possibilitarão copiar os gráficos das suas planilhas pré-existentes, bem como os ranges de dados destas (conjuntos de células previamente selecionados) como uma imagem.
Detalho:
Detalho:
Por vezes desejará não enviar a fonte de dados junto com o gráfico para um Slide que lhe solicitaram.
Talvez deseje enviar uma tabela, um relatório, partes de um Balanced Scorecard, um Dashboards ou um Scorecards, ou mesmo um conjunto deKPIs, sem que estes sejam alterados por quem recebê-los.Criar um informativo regular, parte de um relatório, que envia via MS Outlook, comentários dosrelatórios, agregando conteúdo analítico e não apenas gráficos e dados estáticos para o público alvo.
Como fazê-lo?
Com os recursos abaixo alistados, poderá enviar somente as imagens, como se tirasse uma foto e colasse no Slide, num documento MS Word, num e-mail e até mesmo no Photoshop (há!).
Chega! Essas são apenas algumas das possibilidades...Pensem em outras...
- CÓDIGO:
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
- CÓDIGO:
ActiveChart.CopyPicture Appearance:=xlScreen, Format:=xlPicture
- CÓDIGO:
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
- CÓDIGO:
Worksheets("Nome da pasta").ChartObjects(1).Chart.CopyPictureAppearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
- CÓDIGO:
Worksheets("Nome da pasta").Range("B11:AF25").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Pois é, sempre existem códigos admiráveis por aí:
- CÓDIGO:
Sub GraficoToPowerPoint()
Dim objPPT As Object
Dim objPrs As Object
Dim shtTemp As Worksheet
Dim chtTemp As ChartObject
Dim intSlide As Integer
Set objPPT = CreateObject("Powerpoint.application")
objPPT.Visible = True
objPPT.presentations.Open ThisWorkbook.Path & "\Dashboard_Bernardes.ppt"
objPPT.ActiveWindow.ViewType = 1 'ppViewSlide
For Each shtTemp In ThisWorkbook.Worksheets
For Each chtTemp In shtTemp.ChartObjects
intSlide = intSlide + 1
chtTemp.CopyPicture
If intSlide > objPPT.presentations(1).Slides.Count Then
objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.presentations(1).Slides.Add(Index:=intSlide, Layout:=1).SlideIndex
End If
objPPT.ActiveWindow.View.Paste
Next
Next
objPPT.presentations(1).Save
objPPT.Quit
Set objPrs = Nothing
Set objPPT = Nothing
End Sub
Copiando range e gráfico para o MS Powerpoint:
- CÓDIGO:
Sub GraficoRange_TO_Powerpoint()
Dim objPPT As Object
Dim objPrs As Object
Dim objSld As Object
Dim shtTemp As Object
Dim chtTemp As ChartObject
Dim objShape As Shape
Dim objGShape As Shape
Dim intSlide As Integer
Dim blnCopy As Boolean
Set objPPT = CreateObject("Powerpoint.application")
objPPT.Visible = True
objPPT.Presentations.Add
objPPT.ActiveWindow.ViewType = 1
For Each shtTemp In ThisWorkbook.Sheets
blnCopy = False
If shtTemp.Type = xlWorksheet Then
For Each objShape In shtTemp.Shapes
blnCopy = False
If objShape.Type = msoGroup Then
For Each objGShape In objShape.GroupItems
If objGShape.Type = msoChart Then
blnCopy = True
Exit For
End If
Next
End If
If objShape.Type = msoChart Then blnCopy = True
If blnCopy Then
intSlide = intSlide + 1
objShape.CopyPicture
objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex
objPPT.ActiveWindow.View.Paste
End If
Next
If Not blnCopy Then
intSlide = intSlide + 1
shtTemp.UsedRange.CopyPicture
objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex
objPPT.ActiveWindow.View.Paste
End If
Else
intSlide = intSlide + 1
shtTemp.CopyPicture
objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex
objPPT.ActiveWindow.View.Paste
End If
Next
Set objPrs = Nothing
Set objPPT = Nothing
End Sub
Bônus:
- CÓDIGO:
Sub RangeUsado_TO_Powerpoint()
Dim objPPT As Object
Dim shtTemp As Object
Dim intSlide As Integer
Set objPPT = CreateObject("Powerpoint.application")
objPPT.Visible = True
objPPT.Presentations.Open ThisWorkbook.Path & "\Bernardes.ppt"
objPPT.ActiveWindow.ViewType = 1
For Each shtTemp In ThisWorkbook.Sheets
shtTemp.Range("A1", shtTemp.UsedRange).CopyPicture xlScreen, xlPicture
intSlide = intSlide + 1
objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex
objPPT.ActiveWindow.View.Paste
With objPPT.ActiveWindow.View.Slide.Shapes(objPPT.ActiveWindow.View.Slide.Shapes.Count)
.Left = (.Parent.Parent.SlideMaster.Width - .Width) / 2
End With
Next
Set objPPT = Nothing
End Sub
Tags: VBA, Excel, copy, object, objeto, copiar, chart, gráfico
