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
 

Nenhum comentário:

Postar um comentário

diHITT - Notícias