Şarta bağlı kayan yazı

[adigeturklim]

Merhaba,

Daha önce kayan yazı için aşağıdaki kodları bulmuştum fakat yazılan kodu button ile hareket geçirmek değilde ilgili şart yerine geldiğinde harekete geçirmek istiyorum. Kodu örneğe göre düzeltmek için yardım rica edebilir miyim.
Örnek: E10 hücresi sıfırdan büyük veya küçükse (kod çalışacak şart)

kod:

Private Sub CommandButton1_Click()
Dim A, C
yazı = "YANLIŞ HESAPLAMA"
yazı2 = Space(25) & yazı
For d = 1 To 3
For e = 1 To 25
A = Timer
C = A + 0.1
Do While Timer < C
[B2] = Space(e) & yazı
[B3] = Right(yazı2, Len(yazı2) - e)
k = k - 1
DoEvents
Loop
DoEvents
A = Timer
C = A + 0.1
Next
Next d
[B2] = ""
[B3] = ""
End Sub

 

[Emir Hüseyin Çoban]

. . .

E10 hücresine elle veri girişi yapıyor musunuz yoksa
hücrede formül mü var.

. . .

 

[adigeturklim]

Merhaba Hüseyin Bey, E10 hücresinde formül olacak. formül sonucuna göre sıfırdan büyük veya küçükse kodu tetikleyecek. teşekkür ederim

 

[Emir Hüseyin Çoban]

Formul nedir. Hangi hucrelere gore tetikleniyor.

.

 

[adigeturklim]

Merhaba,
Üzgünüm yanlış ifade etmişim, E178 hücresinde şu formül olacak : TOPLA(D174177) bunun sonucu sıfırdan büyük veya küçük çıkarda E10 hücresinde buna bağlı olarak kayan yazı çalışacak

 

[Emir Hüseyin Çoban]

. . .

Çalışma sayfasının kod bölümüne yapıştırarak deneyiniz..

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [D174:D177]) Is Nothing Then Exit Sub
    If Range("E178") = 0 Then ' Exit Sub
    GoTo atla
    Else
    Dim A, C
    yazı = "YANLIŞ HESAPLAMA"
    yazı2 = Space(25) & yazı
    For d = 1 To 3
        For e = 1 To 25
            A = Timer
            C = A + 0.1
            Do While Timer < C
                [E10] = Space(e) & yazı
                '[E11] = Right(yazı2, Len(yazı2) - e)
                k = k - 1
                DoEvents
            Loop
            DoEvents
            A = Timer
            C = A + 0.1
        Next
    Next d
    [E10] = ""
    '[E11] = ""
    End If

Exit Sub
atla:
[E10] = ""

End Sub

. . .

 

[adigeturklim]

Hocam çalışmadı malesef

 

[Emir Hüseyin Çoban]

. . .

Çalıştıramadığınız dosya ile ekleyin, inceleyelim.

. . .

 

[adigeturklim]

Hocam bu linke ekledim

http://s8.dosya.tc/server/omxx64/ornekdosya_1.rar&46263005

 

[Emir Hüseyin Çoban]

. . .

Link hatalı.

. . .

 

[adigeturklim]

Hocam yeniden link aldım

http://s6.dosya.tc/server5/w2njso/ornekdosya_1.rar.html

 

[Emir Hüseyin Çoban]

. . .

Formül sonucu E178 de olacak demiştiniz. Tablonuzda D178 de..
Kırmızı satırı bulup aşağıdaki ile değiştirin.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [D174:D177]) Is Nothing Then Exit Sub
   [COLOR="Red"] If Range("[B]D[/B]178") = 0 Then[/COLOR] ' Exit Sub
    GoTo atla
    Else

. . .

 

[adigeturklim]

Hocam örnek olarak linklediğim Excel' de kod çalışıyor fakat asıl Excel dosyasına aldığımda kod çalışmıyor. Sebebini anlayamadım. İkisi de .xlsm uzantılı

 

[Emir Hüseyin Çoban]

. . .

Hata uyarısı veriyor mu.
Tablonuzda başka Worksheet_Change ile başlayan kod olabilir.

. . .

 

[adigeturklim]

Hayır hiç hata vermiyor fakat ilgili hücre sonucu sıfırdan büyük veya küçük çıktığında kayan yazı devreye girmiyor.

 

[Emir Hüseyin Çoban]

Tablonuzu gormeden birsey diyemem.
Yine atladiginiz bir yer olabilir..

. . .

 

[adigeturklim]

Hocam gerçek dosya linki aşağıda rica etsem bakabilir misiniz

http://s8.dosya.tc/server2/91u8sb/deneme1.rar.html

 

[adigeturklim]

Hocam dosyada D178 Hücre sonucuna göre E10 hücresine (sarı alan) kayan yazı gelecek. teşekkürler

 

[Emir Hüseyin Çoban]

. . .

En baştada sormuştum size kodları tetikleyecek alan nedir diye.
Kodları [D174177] aralığına veri girince çalıştır şeklinde yaptık. Ancak bu alanlara değerler formülden geliyor.

. . .

 

[adigeturklim]

Hocam yordum sizi, son olarak bi dokunuş daha yapsanız, D178 sıfırdan büyük ve küçükse şeklinde düzeltseniz