Yazıları yanıp söndürme

[polis-53]

Merhaba arkadaşlar aşağıdaki kodla yazıları yanıp söndüreceğim kod hata veriyor bi bakarsanız sevineceğim

Sub FlashFont()
Dim newColor As Integer
Dim myCell As Range
Dim x As Integer
Dim fSpeed
Set myCell = Range(A1)
Application.DisplayStatusBar = True
Application.StatusBar = " Şu an flash yazı gösterisi var lütfen biraz bekleyin...!"
newColor = 4 'yeşil
fSpeed = 0.3
Do Until x = 15 'süre
DoEvents
Start = Timer
Delay = Start + fSpeed
Do Until Timer > Delay
DoEvents
myCell.Font.ColorIndex = newColor
Loop
Start = Timer
Delay = Start + fSpeed
Do Until Timer > Delay
DoEvents
myCell.Font.ColorIndex = xlAutomatic
Loop
x = x + 1
Loop
Application.StatusBar = False
Application.DisplayStatusBar = Application.DisplayStatusBar
End Sub

 

[polis-53]

Sub FlashFont()
Dim newColor As Integer
Dim myCell As Range
Dim x As Integer
Dim fSpeed
Set myCell = Range(A1)
Application.DisplayStatusBar = True
Application.StatusBar = " Şu an flash yazı gösterisi var lütfen biraz bekleyin...!"
newColor = 4 'yeşil
fSpeed = 0.3
Do Until x = 15 'süre
DoEvents
Start = Timer
Delay = Start + fSpeed
Do Until Timer > Delay
DoEvents
myCell.Font.ColorIndex = newColor
Loop
Start = Timer
Delay = Start + fSpeed
Do Until Timer > Delay
DoEvents
myCell.Font.ColorIndex = xlAutomatic
Loop
x = x + 1
Loop
Application.StatusBar = False
Application.DisplayStatusBar = Application.DisplayStatusBar
End Sub

 

[Korhan Ayhan]

Aşağıdaki satırı düzeltip deneyin.

Set myCell = Range(A1)

Olması gereken;

Set myCell = Range("A1")

 

[polis-53]

Teşekkürler korhan bey

 

[Korhan Ayhan]

Ayırca benzer işlemi aşağıdaki kodla da yapabilirsiniz.

Dim Say As Byte

Sub FlashFont()
    Application.StatusBar = "Flash uygulaması çalışıyor. Lütfen bekleyiniz...!"
    If Say = 25 Then
        Say = 0
        Range("A1").Font.ColorIndex = 0
        Application.StatusBar = False
        Exit Sub
    End If
    If Range("A1").Font.ColorIndex = 3 Then
        Range("A1").Font.ColorIndex = 0
    Else
        Range("A1").Font.ColorIndex = 3
    End If
    Say = Say + 1
    Application.OnTime Now + TimeValue("00:00:01"), "FlashFont"
End Sub