ExcelVBA.Net sitesine katkıda bulunabilirsiniz

[Tarkan VURAL]

Form üzerindeki Caption kısmında, CommandButton üzerinde, Label üzerinde, TextBox içinde vs.. timer apisi kullanılarak hazırladığım kayan yazı örnekleri. Umarım faydalı olur.

Module içine ;

Kod: Tümünü seç


Public Declare Function SetTimer Lib "user32" ( _
                        ByVal hwnd As Long, _
                        ByVal nIDEvent As Long, _
                        ByVal uElapse As Long, _
                        ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
            ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
                        ByVal lpClassName As String, _
                        ByVal lpWindowName As String) As Long
Public hwnd As Long, Cl As Integer, at As Integer

Public Sub Timer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
UserForm1.Caption = Animasyon("Www.ExcelVBA.Net         Kod Yazmak Bizim İşimiz           ", 3)
UserForm1.CommandButton1.Caption = Animasyon("Www.ExcelVBA.Net         Kod Yazmak Bizim İşimiz           ", 3)
UserForm1.Label1.Caption = Animasyon("Www.ExcelVBA.Net         Kod Yazmak Bizim İşimiz           ", 3)
UserForm1.TextBox1.Text = Animasyon("Www.ExcelVBA.Net         Kod Yazmak Bizim İşimiz           ", 3)
UserForm1.OptionButton1.Caption = Animasyon("Www.ExcelVBA.Net         Kod Yazmak Bizim İşimiz           ", 3)
End Sub

Public Function Animasyon(str As String, eff As Integer) As String
Dim lop
Cl = Len(str) + 1
at = at + 1
If at >= Cl Then
at = 1
End If
Select Case eff
    Case 0          'Sağ
        Animasyon = Mid(str, at) + Left(str, at)
    Case 1          'Sol
         Animasyon = Mid(str, (Cl - at)) + Left(str, (Cl - at))
    Case 2          'Orta
         Animasyon = Mid(str, (Cl - at)) + Left(str, (Cl - at)) + Mid(str, at) + Left(str, at)
    Case 3          'Sağ Sol
         Animasyon = Mid(str, at) + Left(str, at) + Mid(str, (Cl - at)) + Left(str, (Cl - at))
End Select
End Function
 

UserForm kod sayfasına ;

Kod: Tümünü seç


Private Sub UserForm_Activate()
hwnd = FindWindow(vbNullString, Me.Caption)
SetTimer hwnd, 0, 200, AddressOf Timer
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
KillTimer hwnd, 0
End Sub


[Erhan Yavuz]

Çok güzel bir çalışma, teşekkürler dostum..

[Uygaroz]

Tarkan Bey
Hayırlı Kandiller. Eklemiş olduğunuz dosya (Rar Dosyası) açılırken hata veriyor.
Rica etsem tekrar yükleyebilir misiniz?
Uygar

[Tarkan VURAL]

Sizlere de hayırlı kandiller. Arşivime almamışım. Yeniden oluşturdum ve ilk mesaja ekledim.
Bilginize...

[Uygaroz]

Zahmet oldu.
Çok teşekkürler.
Uygar

[acemi85]

Sayın Tarkan Hocam Emeğinize Sağlık güzel Çalışma olmuş.
Ben kendi bilgisayarımda hata almıyorum,Fakat arkadaşların bilgisayarlarında 64bit Hatası alıyorum fonksiyonlarda bu sorunu nasıl aşabilirim.
Şimdiden teşekkür ederim.

[acemi85]

Modulde Bunu;

Kod: Tümünü seç

#If Win64 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
#Else
Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
#End If
#If Win64 Then
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As LongPtr
#Else
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
#If Win64 Then
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#Else
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#End If
Public hwnd As LongPtr, Cl As Integer, at As Integer

Public Sub TimerProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
'UserForm1.Caption = Animasyon("Www.ExcelVBA.Net         Kod Yazmak Bizim İşimiz           ", 3)
'UserForm1.CommandButton1.Caption = Animasyon("Www.ExcelVBA.Net         Kod Yazmak Bizim İşimiz           ", 3)
UserForm1.Label6.Caption = Animasyon("Www.ExcelVBA.Net         Kod Yazmak Bizim İşimiz           ", 3)
'UserForm1.TextBox1.Text = Animasyon("Www.ExcelVBA.Net         Kod Yazmak Bizim İşimiz           ", 3)
'UserForm1.OptionButton1.Caption = Animasyon("Www.ExcelVBA.Net         Kod Yazmak Bizim İşimiz           ", 3)
End Sub

Public Function Animasyon(str As String, eff As Integer) As String
Dim lop
Cl = Len(str) + 1
at = at + 1
If at >= Cl Then
at = 1
End If
Select Case eff
    Case 0          'Sağ
        Animasyon = Mid(str, at) + Left(str, at)
    Case 1          'Sol
         Animasyon = Mid(str, (Cl - at)) + Left(str, (Cl - at))
    Case 2          'Orta
         Animasyon = Mid(str, (Cl - at)) + Left(str, (Cl - at)) + Mid(str, at) + Left(str, at)
    Case 3          'Sağ Sol
         Animasyon = Mid(str, at) + Left(str, at) + Mid(str, (Cl - at)) + Left(str, (Cl - at))
End Select
End Function


Ama başaramadım Yardımlarınızı bekliyorum ustalarım..
Hayırlı akşamlar.

[Tarkan VURAL]

Hata açıklaması nedir ?

[acemi85]

compile error:
the code in this project must be uptated for use on 64-bit systems. Please review and uptadate Declare statemennts and then mark them with the PtrSafe attribute.

Tarkan bey bir bu hatayi veriyor.
Bir de fonksiyonla ilgili bir hata veriyor userformdaki settimer ve killtimer da.
Onun açıklamasını yarın işe gidince yazarim kusura bakmayin mesajinizi gec gördüm.
İyi aksamlar.

[acemi85]

Günaydın..
Tarkan Ustam Bahsettiğim fonksiyon hatası;
Compile error:
sub Function not defined.

[Tarkan VURAL]

Bendeki işletim sistemi de x64. İlk mesajdaki dosyayı indirdim, denedim. Sorun yaşamadan çalıştığını gördüm. İçerisine 64bit api dönüşümü de henüz yazmadım. Arkadaşınızın bilgisayarındaki Office programından kaynaklanıyor olabilir, bilemedim. Sürümünü ve özelliklerini kontrol ediniz.

[acemi85]

excel 2010 versiyonu ustam çözemiyecek miyiz yoksa

[FENER1907]

Tarkan hocam süper ötesi bir animasyon olmuş.

[Tarkan VURAL]

Merhaba, hoş geldiniz. Beğenmenize sevindim.