3 Ayri hucrede animasyon etkisi, VBA ile

[muraterguden]

Gecen hafta bu soruyu paylastim ama bir kac mesajdan sonra cozum alamadim. Sanirim yeni gelen konular arasinda kaynadi. Tekrar paylasiyorum. Ornek dosyanin linki de asagida;

Dosyamda:
A1 de formul olarak =SUM(A3:A100000) var. B1 ve C1 de kendi kolonlari icin ayni toplamayi yapiyor...
A2 de ki formul ise =A1 , yani bu hucreyi display olarak formatlayip kullaniyorum. B2 ve C2 de ayni sekilde.
A3 ten baslayarak asagi dogru hucrelere her yeni rakam girildiginde A1 toplamayi yapiyor. A2 de istedigim sekilde formatlanmis olarak yeni rakama ulasincaya kadar 0.01 lik artislarla animasyon yaparak devam ediyor. Tabii ayne sey B ve C kolonlari icinde gecerli.
Bunun icin VBA kodu var asagida paylasacagim.
Sorun su;
Bu 3 ayri hucre ayni anda calismiyor. A calisiyorsa B ve C bekliyor, A nin isi bitince B, onunki bitince C basliyor. Paylastigim makro kodu 3 display hucresinin de ayni anda calismasini saglayacak sekilde duzenlenebilirmi?
Simdiden tesekkurler.

Dosyanin linki

İndir progressive test (4)

Dosyayı indir progressive test (4)

dosya.co

(Bu kodu ChatGPT ye yazdirdim)


Private Const DISPLAY_CELL_A = "A2"
Private Const DISPLAY_CELL_B = "B2"
Private Const DISPLAY_CELL_C = "C2"

Private DisplayCellA As Double
Private DisplayCellB As Double
Private DisplayCellC As Double

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongLong)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
DisplayCellA = Range(DISPLAY_CELL_A).Value
DisplayCellB = Range(DISPLAY_CELL_B).Value
DisplayCellC = Range(DISPLAY_CELL_C).Value
Call UpdateDisplayCellA
Call UpdateDisplayCellB
Call UpdateDisplayCellC
End Sub

Private Sub Worksheet_Calculate()
DisplayCellA = Range(DISPLAY_CELL_A).Value
DisplayCellB = Range(DISPLAY_CELL_B).Value
DisplayCellC = Range(DISPLAY_CELL_C).Value
Call UpdateDisplayCellA
Call UpdateDisplayCellB
Call UpdateDisplayCellC
End Sub

Private Sub UpdateDisplayCellA()
Dim A1 As Double
Dim SleepTime As Double

SleepTime = 100 ' Time to wait before updating the display cell in milliseconds
A1 = Range("A1").Value

Do While DisplayCellA < A1
DisplayCellA = DisplayCellA + 0.01
Range(DISPLAY_CELL_A).Value = DisplayCellA
If A1 <> Range("A1").Value Then
Exit Sub
End If
DoEvents ' Allows the user to cancel the operation by pressing Esc
Sleep SleepTime ' Pauses the macro for SleepTime milliseconds
Loop

Range(DISPLAY_CELL_A).Value = A1
End Sub

Private Sub UpdateDisplayCellB()
Dim B1 As Double
Dim SleepTime As Double

SleepTime = 100 ' Time to wait before updating the display cell in milliseconds
B1 = Range("B1").Value

Do While DisplayCellB < B1
DisplayCellB = DisplayCellB + 0.01
Range(DISPLAY_CELL_B).Value = DisplayCellB
If B1 <> Range("B1").Value Then
Exit Sub
End If
DoEvents ' Allows the user to cancel the operation by pressing Esc
Sleep SleepTime ' Pauses the macro for SleepTime milliseconds
Loop

Range(DISPLAY_CELL_B).Value = B1
End Sub

Private Sub UpdateDisplayCellC()
Dim C1 As Double
Dim SleepTime As Double

SleepTime = 100 ' Time to wait before updating the display cell in milliseconds
C1 = Range("C1").Value

Do While DisplayCellC < C1
DisplayCellC = DisplayCellC + 0.01
Range(DISPLAY_CELL_C).Value = DisplayCellC
If C1 <> Range("C1").Value Then
Exit Sub
End If
DoEvents ' Allows the user to cancel the operation by pressing Esc
Sleep SleepTime ' Pauses the macro for SleepTime milliseconds
Loop

Range(DISPLAY_CELL_C).Value = C1
End Sub