• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

kayan yazı ?

  • Konbuyu başlatan Konbuyu başlatan zeze
  • Başlangıç tarihi Başlangıç tarihi
Z

zeze

Katılım
18 Kasım 2004
Mesajlar
85
selam arkadaşlar
bir hücrede ki yazıyı sağdan sola doğru sürekli nasıl kayarak ilerletiriz yani vitrinlerde olur ya hani yazılar akıp gider sürekli...
bir de yanıp sönen yazı yapabilir miyiz? (word de yapabiliyorum fakat excel de yapamadım
teşekkürler
 
Yukarıdaki linkte yer alan çalışma kadar güzel değil ama, alternatif olması açısından ekli dosyaya da bir ara göz atabilirsiniz.

Not: D1 hücresinin "sola dayalı" olarak biçimlendirmeyi unutmuşum . :mrgreen:
 
yanıp sönen yazı için ekteki dosyayı inceleyiniz.



selamlar
 
İsterseniz birde bu kodlarla deneyin.
Yapılacak İşlemler.

Bir Modül Açın,Modülün İçine Aşağıdaki kodları Yazın.
Kod: 
Sub kay()
Dim MyStr As String
Dim i As Integer, j As Integer, k As Double
With Sheets("Sayfa1")
For i = 1 To 10
MyStr = MyStr & .Cells(i, 1) & " " & .Cells(i, 2) & " "
Next
MyStr = WorksheetFunction.Rept(" ", 255 - Len(MyStr)) & MyStr
.Range("C1") = MyStr
Do
For j = 1 To Len(MyStr)
DoEvents
For k = 1 To 100000'Kayan Yazı Hızını ayarlama
k = k + 1
Next
.Range("C1") = Mid(MyStr, j)
Next
Loop
End With
End Sub
Daha Sonra Sayfa1'in Kod sayfasına aşağıdaki kodu yazın.
Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
kay
End Sub
A1 ile B10 Hücre aralıklarına Çıkmasını İstediğiniz Metni Yazın.Burada Metinin kayma Hızını Yukarıdaki kodda bulunan 100000 ile ayarlıyabilirsiniz.
 
İsterseniz birde bu kodlarla deneyin.
Genişletmek için tıkla ...


xxrt, herhalde sabah mahmurluğuyla benim yukarıdaki mesajı ve ekindeki dosyayı görmedin :mrgreen:
 
Kayan Yazı

Haluk' Alıntı:
Yukarıdaki linkte yer alan çalışma kadar güzel değil ama, alternatif olması açısından ekli dosyaya da bir ara göz atabilirsiniz.

Not: D1 hücresinin "sola dayalı" olarak biçimlendirmeyi unutmuşum . :mrgreen:
Genişletmek için tıkla ...

Sub Auto_Open()
AnimatedText
End Sub
'
Sub AnimatedText()
Dim MyStr As String
Dim i As Integer, j As Integer, k As Double
With Sheets("Sheet1")
For i = 1 To 10
MyStr = MyStr & .Cells(i, 1) & " " & .Cells(i, 2) & " "
Next
.Range("D1") = MyStr
Do
For j = 1 To Len(MyStr)
DoEvents
For k = 1 To 5000
k = k + 1
Next
.Range("D1") = ""
.Range("D1") = Mid(MyStr, j)
Next
Loop
End With
End Sub


Bu kodda farklı bir sayfadaki yazıyı kaydırmak için nasıl bir değişiklik yapılması gerekir ?
 
xxrt' Alıntı:
İsterseniz birde bu kodlarla deneyin.
Yapılacak İşlemler.

Bir Modül Açın,Modülün İçine Aşağıdaki kodları Yazın.
Kod: 
Sub kay()
Dim MyStr As String
Dim i As Integer, j As Integer, k As Double
With Sheets("Sayfa1")
For i = 1 To 10
MyStr = MyStr & .Cells(i, 1) & " " & .Cells(i, 2) & " "
Next
MyStr = WorksheetFunction.Rept(" ", 255 - Len(MyStr)) & MyStr
.Range("C1") = MyStr
Do
For j = 1 To Len(MyStr)
DoEvents
For k = 1 To 100000'Kayan Yazı Hızını ayarlama
k = k + 1
Next
.Range("C1") = Mid(MyStr, j)
Next
Loop
End With
End Sub
Daha Sonra Sayfa1'in Kod sayfasına aşağıdaki kodu yazın.
Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
kay
End Sub
A1 ile B10 Hücre aralıklarına Çıkmasını İstediğiniz Metni Yazın.Burada Metinin kayma Hızını Yukarıdaki kodda bulunan 100000 ile ayarlıyabilirsiniz.
Genişletmek için tıkla ...

Değerli ustalar sayın xxrt nin yazmış olduğu aralığı c2 ve h8 aralıklarına nasıl yazdırabiliriz .

yardımlarınız için teşekkürler
 
Son düzenleme:
Merhaba 6.mesajdaki kodu sağa ilerleyen yazı haline nasıl dönüştürebiliriz
 
Merhaba İlginiz için teşekkür ederim.Karmaşık ve fazla yer kaplamasın istiyorum.Ve dosya açılınca kendiliğinden çalışsın .Örnek belirtmiş olduğum koddaki yazı sağa ilerlesin yeterli
 
Sayın Plint merhaba kod çalışıyor ama sanırım işlemciyi kasıyor.Dosyanın status bar bölümünde Hazır ve hesaplanıyor(4işlemci% ) yazısı yanıp sönüyor.başka dosyalarımda şu kodu kullanıyordum .Herhangi bi sorun yoktu Bu kodda değişiklikle sağa kayan haline dönüştürebilir miyiz.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Single
Dim ilk, son, veri As String
Do While (True)
DoEvents
ilk = Left(Cells(35, 2), 1)
son = Mid(Cells(35, 2).Value, 2, Len(Cells(35, 2).Value) - 1)
Cells(35, 2).Value = son + ilk
For i = 1 To 12000000
Next i
veri = Cells(35, 2).Value
Loop
End Sub

Bu kodu sayfanın kod bölümüne yapıştırmamız yeterli oluyor.Aynı sayfada iki koduda çalıştırabilir miyiz .Hücrelerin biri sağa biri sola kayan yazı haline gelecek şekilde
 
önder34' Alıntı:
Sayın Plint merhaba kod çalışıyor ama sanırım işlemciyi kasıyor.Dosyanın status bar bölümünde Hazır ve hesaplanıyor(4işlemci% ) yazısı yanıp sönüyor.
Genişletmek için tıkla ...
Merhaba
Gördüğünüz hesaplama kodların içinde bulunan fonksiyondan kaynaklanıyor; bu görünen, asıl yük döngülerden meydana gelir.Sizin kullandığınızın farkı içinde fonksiyon olmaması her ikisindede Win.Görev yöneticisinde CPU kullanımı 25 yani yorucu
Sizin kodlarla şöyle olabilir.(Ama kullanışlı olmayacaktır)
Kod: 
[SIZE="2"] Set S1 = Sheets("Sayfa1")
S1.Activate
Dim i, x, n
Dim ilk, ilk2 As String
Do While (True)
DoEvents
ilk = "MERHABA"          [COLOR="Red"]'VEYA ilk = s1.[B2][/COLOR]
ilk2 = Space(30) & ilk
x = 0
For i = 1 To 30
x = x + 1
For n = 1 To 50    [COLOR="Red"]'HIZ AYARI[/COLOR]
S1.[D6] = Space(i) & ilk
S1.[D7] = Right(ilk2, Len(ilk2) - x)
Next
Next
Loop  [/SIZE]
Şu örnek bunlara göre biraz daha kullanışlı olacaktır.
http://s3.dosya.tc/server7/yjuhgf/KAYAN_YAZI.zip.html

Kod: 
Set s1 = Sheets("Sayfa1")
Dim A, C
yazı = s1.[A1].Value       [COLOR="Red"]'KAYAN YAZININ ALINACAĞI HÜCRE[/COLOR]
yazı2 = Space(25) & yazı
For d = 1 To 15
For e = 1 To 25
 A = Timer
 C = A + 0.1    [COLOR="Red"]'HIZ AYARI[/COLOR]
Do While Timer < C
s1.[B2] = Space(e) & yazı   [COLOR="Red"]'SOLDAN SAĞA[/COLOR]
s1.[B3] = Right(yazı2, Len(yazı2) - e)  [COLOR="Red"]'SAĞDAN SOLA[/COLOR]
DoEvents
Loop
DoEvents
A = Timer
C = A + 0.1     [COLOR="Red"]'HIZ AYARI[/COLOR]
Next
Next d
s1.[B2] = ""
s1.[B3] = ""
 
Son düzenleme:
Sayın Plint her iki çalışmada çok güzel olmuş.Birinci kodda hızı ayarlayamadım bir türlü ayrıca
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
....
...
...
End Sub
arasına almadan çalışmadı.Heriki koduda aynı sayfada kullanabilecekmiyim.Ben kullanamadım
 
önder34' Alıntı:
Sayın Plint her iki çalışmada çok güzel olmuş.Birinci kodda hızı ayarlayamadım bir türlü ayrıca
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
....
...
...
End Sub
arasına almadan çalışmadı.Heriki koduda aynı sayfada kullanabilecekmiyim.Ben kullanamadım
Genişletmek için tıkla ...
İki kodu bir arada kullanamazsınız ikinci kodları kullanın ilk kodlar önceki
mesajınızda istediğiniz içindir.

Yukarıdaki kodlara eklemeler yapmaya çalıştım bir inceleyin,birinci kod kullanışlı
olmayacaktır. Açıklamalı örnek dosya eklerseniz daha iyi sonuç alabilirsiniz
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst