Este fórum está sendo desativado

[jfelicio1]

Boa tarde,

Tenho uma macro que ajusta a escala do gráfico e no final ela chama o timer de 5 segundos que volta a reajustar a escala.

Eu queria que ela rodasse apenas quando a aba/planilha “Gráficos” fosse acionada e se eu trocar de aba ele parasse de rodar esse timer e a macro.

att

[osvaldomp]

Código: Selecionar todos

Private Sub Worksheet_Activate()
 'coloque aqui o código qua ativa o timer
End Sub

Código: Selecionar todos

Private Sub Worksheet_Deactivate()
 'coloque aqui um código para desativar o timer
End Sub

Lembrando que os dois códigos acima devem ser instalados no módulo da planilha de interesse.

[jfelicio1]

O problema é que meu timer após 5 segunds, chama a Sub para ajustar escala, se eu colocar uma Sub dentro do Private Sub, ele não reconhece. Tem que fazer uma adaptação?

[osvaldomp]

Coloque aqui os códigos atuais, o que ativa e o que desativa o timer.

[jfelicio1]

**** CÓDIGO QUE CORRIGE A ESCALA GRÁFICA *****

Public saveTime As Double

Sub grafico()


'PURPOSE: Adjust Y-Axis according to Min/Max of Chart Data
'SOURCE: www.TheSpreadsheetGuru.com

Dim cht As ChartObject
Dim srs As Series
Dim FirstTime As Boolean
Dim MaxNumber As Double
Dim MinNumber As Double
Dim MaxChartNumber As Double
Dim MinChartNumber As Double
Dim Padding As Double

'Input Padding on Top of Min/Max Numbers (Percentage)
Padding = 0.1 'Number between 0-1

'Optimize Code
Application.ScreenUpdating = False

'Loop Through Each Chart On ActiveSheet
For Each cht In ActiveSheet.ChartObjects

'First Time Looking at This Chart?
FirstTime = True

'Determine Chart's Overall Max/Min From Connected Data Source
For Each srs In cht.Chart.SeriesCollection
'Determine Maximum value in Series
MaxNumber = Application.WorksheetFunction.Max(srs.Values)

'Store value if currently the overall Maximum Value
If FirstTime = True Then
MaxChartNumber = MaxNumber
ElseIf MaxNumber > MaxChartNumber Then
MaxChartNumber = MaxNumber
End If

'Determine Minimum value in Series (exclude zeroes)
MinNumber = Application.WorksheetFunction.Min(srs.Values)

'Store value if currently the overall Minimum Value
If FirstTime = True Then
MinChartNumber = MinNumber
ElseIf MinNumber < MinChartNumber Or MinChartNumber = 0 Then
MinChartNumber = MinNumber
End If

'First Time Looking at This Chart?
FirstTime = False
Next srs

'Rescale Y-Axis
cht.Chart.Axes(xlValue).MinimumScale = MinChartNumber * (1 - Padding)
cht.Chart.Axes(xlValue).MaximumScale = MaxChartNumber * (1 + Padding)

Next cht

'Optimize Code
Application.ScreenUpdating = True

Call timer_grafico

End Sub

***** CÓDIGO QUE ATIVA O TIMER *****
Sub timer_grafico()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculateManual

saveTime = Now + TimeValue("00:00:05")
Application.OnTime EarliestTime:=saveTime, Procedure:="grafico", Schedule:=True


Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

***** CÓDIGO QUE DESATIVA O TIMER *****

Sub stop_grafico()

On Error Resume Next

Application.OnTime saveTime, "grafico", , False

End Sub

[osvaldomp]

Experimente:

Código: Selecionar todos

Private Sub Worksheet_Activate()
 timer_grafico
End Sub

Código: Selecionar todos

Private Sub Worksheet_Deactivate()
 stop_grafico
End Sub