VBA Excel Intermediário - Mudando a Referência de Vários Gráficos ao mesmo tempo

VBA Excel Intermediário - Mudando a Referência de Vários Gráficos ao mesmo tempo

Vez ou outra precisamos mover nossos gráficos entre planilhas e neste momento dá um frio na barriga, porque para isso precisaremos mexer em todas as referências dos gráficos contidos em nossa activesheet.

E como pode imaginar, fazer isso manualmente certamente propiciará erros. Sim, não há nada mais fácil do que implementar erros durante o momento de uma transcrição de código e/ou referências. 

Neste momento seria muito bom termos à disposição um código que fizesse isso para nós hein! Que tal se apenas precisássemos colar o código, posicionarmo-nos dentro da planilha onde todas as referências precisem ser corrigidas e voilá, TODAS AS REFERÊNCIAS são acertadas sem alterar nenhuma configuração prévia dos nossos gráficos.

Pensando nisso, compartilho o código abaixo, o qual, espero, possa livrá-los de transtornos...

Sub ChangeSeriesFormulaAllCharts()

    '      Author: André Luiz Bernardes - A&A - In Any Place - andreluizbernardes@gmail.com

    '        Date: 13/05/2016 - 11:45

    ' Application: Field Force Dashboard Analysis® - © A&A - In Any Place 2016, Inc. Todos os direitos reservados.

    '     Company: © A&A - In Any Place 2016, Inc. Todos os direitos reservados.

    '     Purpose: Extract old reference and put new chart references

    ''' Do all charts in sheet

    Dim oChart As ChartObject

    Dim OldString As String, NewString As String

    Dim mySrs As Series

    Let OldString = "[REUNIAO PERFORMANCE.xlsx]" 'InputBox("Enter the string to be replaced:", "Enter old string")

    If Len(OldString) > 1 Then

        Let NewString = ""  'InputBox("Enter the string to replace " & """" _

            & OldString & """:", "Enter new string")

     

        For Each oChart In ActiveSheet.ChartObjects

            Debug.Print oChart.Name

         

            For Each mySrs In oChart.Chart.SeriesCollection

                Debug.Print "CHART " & oChart.Name & " OLD: " & mySrs.Formula & " NEW: " & Replace(mySrs.Formula, OldString, NewString)

                Let mySrs.Formula = Replace(mySrs.Formula, OldString, NewString)

            Next

        Next

    Else

        MsgBox "Nothing to be replaced.", vbInformation, "Nothing Entered"

    End If

End Sub

 

VBA Excel - Convertendo em Imagens

Consultancy in Excel, Access, VBA & PowerPoint projects

DESENVOLVO APLICAÇÕES

Perguntas, Questões e Esclarecimentos

Lembro-me de há alguns anos, quando criei um Blog específico de VBA. Recordo-me como 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 Infográficos e até mesmo a inserção destes em páginas da Web de modo automático (Sharepoint). 

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. 

Detalhes:
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 dos
relató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: SELECIONAR TUDO

ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

Para copiar um gráfico selecionado (ou ativo) em uma planilha, implemente a seguinte sintaxe: 

CÓDIGO: SELECIONAR TUDO

ActiveChart.CopyPicture Appearance:=xlScreen, Format:=xlPicture

Copiando um range de dados, colando-a como uma imagem: 

CÓDIGO: SELECIONAR TUDO

Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

Copie gráficos selecionados (ou ativo) em uma planilha, implemente a seguinte sintaxe: 

CÓDIGO: SELECIONAR TUDO

Worksheets("Nome da pasta").ChartObjects(1).Chart.CopyPictureAppearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

Copie uma faixa de dados específica, embora não esteja selecionada, colando-a a posteriori: 

CÓDIGO: SELECIONAR TUDO

Worksheets("Nome da pasta").Range("B11:AF25").CopyPicture Appearance:=xlScreen, Format:=xlPicture

Pois é, sempre existem códigos admiráveis por aí: 

CÓDIGO: SELECIONAR TUDO

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: SELECIONAR TUDO

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: SELECIONAR TUDO

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

VBA Powerpoint - Atualizando gráfico com dados do MS Excel

Consultancy in Excel, Access, VBA & PowerPoint projects

DESENVOLVO APLICAÇÕES

Perguntas, Questões e Esclarecimentos

Atualize o gráfico no MS Powerpoint através de dados em planilha MS Excel.

'Code by Mahipal Padigela'Open Microsoft Powerpoint,Choose/Insert a Graph type Slide(No.8), then double click to add a graph and click...
'...outside the graph to close the Datasheet, then rename the Graph to "Mychart",Save and Close the Presentation'Open Microsoft Excel, add some test data to Sheet1(This example assumes that you have some test data...
'...(numbers between 0-100) in Rows 2,3,4 and Columns B,C,D,E).'Open VBA editor(Alt+F11),Insert a Module and Paste the following code in to the code window
'Reference 'Microsoft Powerpoint Object Library' (VBA IDE-->tools-->references)'Reference 'Microsoft Graph Object Library' (VBA IDE-->tools-->references)
'Change "strPresPath" with full path of the Powerpoint Presentation created earlier.'Change "strNewPresPath" to where you want to save the new Presnetation to be created later
'Close VB Editor and run this Macro from Excel window(Alt+F8)

Dim oPPTApp As PowerPoint.ApplicationDim oPPTShape As PowerPoint.ShapeDim oPPTFile As PowerPoint.Presentation
Public oGraph As Graph.ChartDim SlideNum As Integer

Sub PPGraphMacro()

Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As

StringstrPresPath = "H:\PowerPoint\Presentation1.ppt"
strNewPresPath = "H:\PowerPoint\New1.ppt" 

Set oPPTApp = CreateObject("PowerPoint.Application")oPPTApp.Visible = msoTrue
Set oPPTFile = oPPTApp.Presentations.Open(strPresPath)
SlideNum = 1oPPTFile.Slides(SlideNum).Select
Set oPPTShape = oPPTFile.Slides(SlideNum).Shapes("Mychart")
Set oGraph = oPPTShape.OLEFormat.Object 

Sheets("Sheet1").ActivateoGraph.Application.DataSheet.Range("A1").Value = Cells(2, 2).Value
oGraph.Application.DataSheet.Range("A2").Value = Cells(3, 2).ValueoGraph.Application.DataSheet.Range("A3").Value = Cells(4, 2).Value
oGraph.Application.DataSheet.Range("B1").Value = Cells(2, 3).ValueoGraph.Application.DataSheet.Range("B2").Value = Cells(3, 3).Value
oGraph.Application.DataSheet.Range("B3").Value = Cells(4, 3).ValueoGraph.Application.DataSheet.Range("C1").Value = Cells(2, 4).Value
oGraph.Application.DataSheet.Range("C2").Value = Cells(3, 4).ValueoGraph.Application.DataSheet.Range("C3").Value = Cells(4, 4).Value
oGraph.Application.DataSheet.Range("D1").Value = Cells(2, 5).ValueoGraph.Application.DataSheet.Range("D2").Value = Cells(3, 5).Value
oGraph.Application.DataSheet.Range("D3").Value = Cells(4, 5).Value 

'Should you need to access the Graph axes to turn them On/Off or to set ranges etc etc...use this'

oGraph.HasAxis(xlValue, xlPrimary) = True ' Shows Y-axis on the graph'
Set oAxis = oGraph.Axes(xlValue)'
With oAxis' .MinimumScale = 0'
.MaximumScale = 1.2'
End With'

oGraph.HasAxis(xlValue, xlPrimary) = False ' Hides Y-axis on the graph

Dim i as Integer' 

For i = 1 To oGraph.SeriesCollection(1).Points.Count'
If oGraph.Application.DataSheet.Cells(i, 2).Value >= 50 Then'
oGraph.SeriesCollection(1).Points(i).MarkerBackgroundColorIndex = 3'
oGraph.SeriesCollection(1).Points(i).MarkerForegroundColorIndex = 3'
Else'
oGraph.SeriesCollection(1).Points(i).MarkerBackgroundColorIndex = 6'
oGraph.SeriesCollection(1).Points(i).MarkerForegroundColorIndex = 6'
End If'

Next i

oGraph.Application.Update
oGraph.Application.Quit 
oPPTFile.SaveAs strNewPresPath
oPPTFile.Close
oPPTApp.Quit 

Set oGraph = Nothing
Set oPPTShape = Nothing
Set oPPTFile = Nothing
Set oPPTApp = Nothing

MsgBox "Presentation Created", vbOKOnly + vbInformation

End Sub

Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...

Tags: VBA, excel, chart, powerpoint,

VBA Excel - Salve um gráfico como uma imagem - How to Save a Chart as Image using Excel VBA

Consultancy in Excel, Access, VBA and PowerPoint projects

DESENVOLVO APLICAÇÕES

Perguntas, Questões e Esclarecimentos

Que tal tornar mais fácil o envio dos seus gráficos para um Slide do MS Powerpoint, ou mesmo para documentos no MS Word?

Sub SaveChartAsImage()

Dim oCht As Chart

Set oCht = ActiveChart

On erRROR GoTo Err_Chart

' Escolha qual o formato que prefere:

oCht.Export Filename:="C:\Bernardes\Images\PopularICON.jpg", Filtername:="JPG"

'oCht.Export Filename:="C:\Bernardes\Images\ExcelChartExport.png", Filtername:="png"

Err_Chart:

If Err <> 0 Then

Debug.Print Err.Description

Err.Clear

End If

End Sub

Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...

Tags: VBA, Excel, Chart, Image, Save, Chart to Image, Conversion, Chart to GIF, Export, Jpeg

Pharma Brazil: FRANÇA - Mais velha, mais esperta, mais valor consciente: A transformação do consumidor

|Blog Office VBA | Blog Excel | Blog Access | Blog Infochart | 

DESENVOLVO APLICAÇÕES VBA

Perguntas, Questões e Esclarecimentos

O que é o fenômeno chamado BIG DATA?

Acesse uma ENORME lista de Dashboards e Infográficos

Aprenda a detectar gráficos que precisam mudar

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Dashboards e Infocharts - Diversas Visualizações de Dados

Diversos exemplos de Gráficos

Excel - DashMap - Mapa do Brasil

Key Performance Indicators - 7 Características desejáveis

MIS - Usufruindo a excelência na análise das suas Informações

O Melhor do Business Intelligence

Os 10 mandamentos do gerenciamento de projetos

Receba  3 Calendários Customizáveis de  2013 em Excel

Usando Gauges em Dashboards no MS Access

As tendências de longo prazo remodelam a paisagem do consumidor na França e têm implicações em outros países desenvolvidos também.

Ao longo dos próximos 20 anos tendências demográficas, sociais e econômicas poderosas prometem reformular substancialmente o comportamento do consumidor em muitas das nações mais ricas do mundo. As implicações para os negócios será significativas. Para entender melhor essas tendências, analisou-se algumas perspectivas na França e descobriu-se que lá, como em muitos dos seus vizinhos europeus, a família média em 2030 será mais velha, mais instruída e menos rica do que a média das famílias de 2010.

Encontramos três tendências de longo prazo, atingindo um ponto de inflexão que transformará radicalmente os países:

- O envelhecimento da população, 

- Mudanças sociais que alteram como as famílias se parecem, e

- Fatores econômicos retardando a expansão da riqueza. 

Como essas tendências varrerão a França e, em graus variados, o resto da Europa, imporão pressão sobre o crescimento do consumo, mudando radicalmente a paisagem do consumidor.

Uma nação em transformação

A população da França está envelhecendo com o aumento da longevidade, as taxas de queda da fertilidade, e os mais velhos da geração baby boom. Estas tendências têm implicações econômicas profundas, pressionando o crescimento do PIB per capita, e o poder de compra e consumo. Talvez em 2030, por exemplo, mais de metade de todas as famílias francesas sejam dirigidas por alguém com 55 anos ou mais. Em toda a Europa, apenas dois trabalhadores apoiarão cada aposentado em 2050, em comparação com quatro de hoje, a menos que haja mudanças da idade de aposentadoria.

Uma série de mudanças sociais estão reformulando a família francesa média. Estes incluem aumento da escolaridade, mais mulheres participando do mercado de trabalho e famílias menores, menos casais formais e a queda da taxa de natalidade. Prevemos que o número de famílias francesas com casais que vivem juntos caia para 58 por cento em 2030, dos 75 por cento em 1980, enquanto as famílias terão uma média de 2,5 membros, contra 3,3 em 1980.

Tags: chart, Pharma, farmacêutica, análise, Data Mining, algoritmo, Mineração de Dados, keyword,  global, pharmaceutical, Sales, products, Georges Desvaux, Baudouin Regout, McKinsey Quarterly, McKinsey Global Institute,