kayan yazı ?

[zeze]

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

 

[Hüseyin]

http://www.excel.web.tr/showthread.php?t=1626

 

[zeze]

teşekkür ettim dostum
bu çok teferruatlıymış

 

[Haluk]

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:

 

[Levent Menteşoğlu]

yanıp sönen yazı için ekteki dosyayı inceleyiniz.



selamlar

 

[xxrt]

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

Bir Modül Açın,Modülün İçine Aşağıdaki kodları Yazın.

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.

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.

 

[Haluk]

İsterseniz birde bu kodlarla deneyin.

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

 

[holifera]

:dua:

 

[zeze]

arkadaşlar herkeze çok teşekkür ederim

 

[ozgurpeh]

Kayan Yazı

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:

Sub Autpen()
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 ?

 

[ressevet]

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

Bir Modül Açın,Modülün İçine Aşağıdaki kodları Yazın.

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.

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.

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

 

[ressevet]

Değerli arkadaşlar soruma bi cevap verebilirmisiniz

 

[önder34]

Merhaba 6.mesajdaki kodu sağa ilerleyen yazı haline nasıl dönüştürebiliriz

 

[sakman26]

selam,
Web Browser nesnesi ile yapılmış örneği inceleyiniz.
kolay gelsin..

link : http://s3.dosya.tc/server7/48isyx/onder34.zip.html

 

[önder34]

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

 

[PLİNT]

Merhaba 6.mesajdaki kodu sağa ilerleyen yazı haline nasıl dönüştürebiliriz

Merhaba

Kodların içindeki "J" döngü başlangıcını

For j = Len(MyStr) To 1 Step -1

Şeklinde değiştirip deneyin.

 

[önder34]

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

 

[PLİ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.

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)

[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

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] = ""

 

[önder34]

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

 

[PLİ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

İ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