Activer une horloge analogique en VBA sur plusieurs feuilles

Bonjour,

J'aimerais pouvoir lancer une horloge analogique depuis plusieurs feuilles sans devoir recréer un module pour chaque onglet.

Vous semble-t'il possible de modifier en conséquence le code ci-après, je vous remercie par avance.

Sub cbClockType_Click()

' Hides or unhids the clock

With ThisWorkbook.Sheets("Clock")

If .DrawingObjects("cbClockType").Value = xlOn Then

.ChartObjects("ClockChart").Visible = True

Else

.ChartObjects("ClockChart").Visible = False

End If

End With

End Sub

Sub UpdateClock()

' Updates the clock that's visible

Dim Clock As Chart

Set Clock = ThisWorkbook.Sheets("Clock").ChartObjects("ClockChart").Chart

If Clock.Parent.Visible Then

' ANALOG CLOCK

Const PI As Double = 3.14159265358979

Dim CurrentSeries As Series

Dim s As Series

Dim x(1 To 2) As Variant

Dim v(1 To 2) As Variant

' Hour hand

Set CurrentSeries = Clock.SeriesCollection("HourHand")

x(1) = 0

x(2) = 0.5 * Sin((Hour(Time) + (Minute(Time) / 60)) * (2 * PI / 12))

v(1) = 0

v(2) = 0.5 * Cos((Hour(Time) + (Minute(Time) / 60)) * (2 * PI / 12))

CurrentSeries.XValues = x

CurrentSeries.Values = v

' Minute hand

Set CurrentSeries = Clock.SeriesCollection("MinuteHand")

x(1) = 0

x(2) = 0.8 * Sin((Minute(Time) + (Second(Time) / 60)) * (2 * PI / 60))

v(1) = 0

v(2) = 0.8 * Cos((Minute(Time) + (Second(Time) / 60)) * (2 * PI / 60))

CurrentSeries.XValues = x

CurrentSeries.Values = v

' Second hand

Set CurrentSeries = Clock.SeriesCollection("SecondHand")

x(1) = 0

x(2) = 0.85 * Sin(Second(Time) * (2 * PI / 60))

v(1) = 0

v(2) = 0.85 * Cos(Second(Time) * (2 * PI / 60))

CurrentSeries.XValues = x

CurrentSeries.Values = v

Else

' DIGITAL CLOCK

ThisWorkbook.Sheets("Clock").Range("DigitalClock").Value = CDbl(Time)

End If

' Set up the next event one second from now

NextTick = Now + TimeValue("00:00:01")

Application.OnTime NextTick, "UpdateClock"

End Sub

Le principe de la méthode empirique est affaire de temps.

A force de chercher et tester, j'ai pu modifier le code; il est opérationnel sur chaque feuille de mon classeur.

Sub UpdateClock()

' Updates the clock that's visible

Dim Clock As Chart

Set Clock = ActiveSheet.ChartObjects("ClockChart").Chart

If Clock.Parent.Visible Then

' ANALOG CLOCK

Const PI As Double = 3.14159265358979

Dim CurrentSeries As Series

Dim s As Series

Dim x(1 To 2) As Variant

Dim v(1 To 2) As Variant

' Hour hand

Set CurrentSeries = Clock.SeriesCollection("HourHand")

x(1) = 0

x(2) = 0.5 * Sin((Hour(Time) + (Minute(Time) / 60)) * (2 * PI / 12))

v(1) = 0

v(2) = 0.5 * Cos((Hour(Time) + (Minute(Time) / 60)) * (2 * PI / 12))

CurrentSeries.XValues = x

CurrentSeries.Values = v

' Minute hand

Set CurrentSeries = Clock.SeriesCollection("MinuteHand")

x(1) = 0

x(2) = 0.8 * Sin((Minute(Time) + (Second(Time) / 60)) * (2 * PI / 60))

v(1) = 0

v(2) = 0.8 * Cos((Minute(Time) + (Second(Time) / 60)) * (2 * PI / 60))

CurrentSeries.XValues = x

CurrentSeries.Values = v

' Second hand

Set CurrentSeries = Clock.SeriesCollection("SecondHand")

x(1) = 0

x(2) = 0.85 * Sin(Second(Time) * (2 * PI / 60))

v(1) = 0

v(2) = 0.85 * Cos(Second(Time) * (2 * PI / 60))

CurrentSeries.XValues = x

CurrentSeries.Values = v

End If

' Set up the next event one second from now

NextTick = Now + TimeValue("00:00:01")

Application.OnTime NextTick, "UpdateClock"

End Sub

Rechercher des sujets similaires à "activer horloge analogique vba feuilles"