status bar 'a sayfadan veri eklemek

Katılım
11 Ekim 2005
Mesajlar
140
merhaba, status bar da, kayan yazılara, sayfadan veri eklemek istedim fakat olmadı hatamı düzeltebilirmisiniz.teşekkürler.syg.

Sub basla()
On Error Resume Next

Sheets("sheet1").Select
10 If c > 1 Then c = 0
Start = Timer * 16
Do
DoEvents
finish = Timer * 16
deg = Format(finish - Start, "0")
If c < 1 Then
Application.StatusBar = Mid(Sheets("sheet1").Range("a1:a10"), 29 - deg, deg)
End If
If c > 0 Then
bos = 30 - Len(Mid(Sheets("sheet1").Range("a1:a10"), 1, 29 - deg))
For a = 1 To bos
bosluk = bosluk & " "
Next
Application.StatusBar = bosluk & Mid(Sheets("sheet1").Range("a1:a10"), 1, 29 - deg)
End If
bosluk = ""
Loop While finish - Start <= 28
c = c + 1
GoTo 10
End Sub
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Aşağıdaki gibi deneyin. Kayan yazı A1 hücresinden alınmaktadır.

[vb:1:db1d3c1c51]Sub basla()
On Error Resume Next
Sheets("sheet1").Select
10 If c > 1 Then c = 0
Start = Timer * 16
Do
DoEvents
finish = Timer * 16
deg = Format(finish - Start, "0")
If c < 1 Then
Application.StatusBar = Mid(Sheets("sheet1").Range("a1"), Len([a1]) - deg + 1, deg)
End If
If c > 0 Then
bos = Len([a1]) - Len(Mid(Sheets("sheet1").Range("a1"), 1, Len([a1]) - deg + 1))
Application.StatusBar = WorksheetFunction.Rept(" ", bos) & Mid(Sheets("sheet1").Range("a1"), 1, Len([a1]) - deg + 1)
End If
bosluk = ""
Loop While finish - Start <= Len([a1]) - 1
c = c + 1
GoTo 10
End Sub
[/vb:1:db1d3c1c51]
 

Seyit Tiken

Uzman
Uzman
Katılım
23 Ağustos 2005
Mesajlar
4,651
Excel Vers. ve Dili
Excel : 2010
Bu kodu bir inceleyiniz.

Sub Düğme1_Tıklat()
On Error Resume Next
kelime = Range("A1") & " " & "Kenan GÜLAL"
10 If c > 1 Then c = 0
Start = Timer * 8
Do
DoEvents
finish = Timer * 8
deg = Format(finish - Start, "0")
If c < 1 Then
Application.StatusBar = Mid(kelime, 29 - deg, deg)
End If
If c > 0 Then
bos = 16 - Len(Mid(kelime, 1, 29 - deg))
For a = 1 To bos
bosluk = bosluk & " "
Next
Application.StatusBar = bosluk & Mid(kelime, 1, 29 - deg)
End If
bosluk = ""
Loop While finish - Start <= 28
c = c + 1
GoTo 10
End Sub
 
Katılım
11 Ekim 2005
Mesajlar
140
sayın leventm , sayın seyit tiken koddaki hatamı buldum ama siz benden evvel davrandınız , Range("a1:a10") kısmı Range("a1"), olmalıydı.
bu şekilde yazmamın sebebi ise a1 hücresi status bardan geçetikten sonra bir alt hücreye geçmesini planlamamdı. peki bu konuda yardımcı olabilirmisiniz a1 hücresinden sonra a2,a3... gibi devam edebilirmi.yardımlarınız için teşekkür ederim.
 

Seyit Tiken

Uzman
Uzman
Katılım
23 Ağustos 2005
Mesajlar
4,651
Excel Vers. ve Dili
Excel : 2010
Kodun ilgili yerinde şöyle yapın. &" "& yani A2 hücresini bu şekilde A1 hücresine bağlayın.
 
Üst