AW: Laufleiste (ähnlich Live-Ticker)
01.02.2008 17:41:00
ransi
Hallo MArc
Pack diesen Code mal in ein Modul:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
'Originalcode ist von Nepumuk
'Habs nur auf die StatusBar umgestrickt.
Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function SetTimer Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long
Private Const gcClassnameMSExcel = "XLMAIN"
Private Const strText As String = "Das ist der Text der durchlaufen soll"
Private hWnd As Long
Public Sub prcTimerStart()
hWnd = FindWindow(gcClassnameMSExcel, Application.Caption)
SetTimer hWnd, 0&, 100&, AddressOf prcTimer
End Sub
Public Sub prcTimerStop()
KillTimer hWnd, 0&
Application.StatusBar = ""
End Sub
Private Sub prcTimer(ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Static intCount As Integer
On Error Resume Next
Application.StatusBar = Mid$(strText, intCount) & " " & Mid$(strText, 1, intCount)
intCount = intCount + 1
If intCount > Len(strText) Then intCount = 1
End Sub
Und das hier unter DieseArbeitsmappe:
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Workbook_Activate()
Call prcTimerStart
End Sub
Private Sub Workbook_Deactivate()
Call prcTimerStop
End Sub
ransi