AW: ... noch offen vergessen ;o)
03.02.2015 22:25:52
Mullit
Hallo Arthur,
da wirst Du etwas mehr Gummi geben und Dir bspw. mit dem Api-Timer was bauen müssen:
' **********************************************************************
' Modul: UserForm1 Typ: Userform
' **********************************************************************
Option Explicit
Private mblnActivate As Boolean
Private Sub UserForm_Activate()
mblnActivate = Not mblnActivate
Call prcStartTimer
End Sub
Private Sub UserForm_Terminate()
If mblnActivate Then _
mblnActivate = Not mblnActivate
Call prcStopTimer
End Sub
Friend Property Get prpblnActivate() As Boolean
prpblnActivate = mblnActivate
End Property
Friend Property Let prpblnActivate(ByVal pvblnVariable As Boolean)
mblnActivate = pvblnVariable
End Property
' **********************************************************************
' Modul: Typ: Standardmodul
' **********************************************************************
Option Explicit
Option Private Module
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 Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Private Const GC_CLASSNAMEMSEXCELFORM As String = "ThunderDFrame"
Private llngHwnd As Long
Public Sub prcStartTimer()
llngHwnd = FindWindow(GC_CLASSNAMEMSEXCELFORM, UserForm1.Caption)
SetTimer llngHwnd, 0&, 1&, AddressOf TimerProc
End Sub
Public Sub prcStopTimer()
KillTimer llngHwnd, 0&
End Sub
Private Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Static sblnInit As Boolean
With UserForm1
If GetForegroundWindow = llngHwnd Then
If Not .prpblnActivate And Not sblnInit Then
Call prcMyProg
sblnInit = Not sblnInit
End If
Else
If .prpblnActivate Then _
.prpblnActivate = Not .prpblnActivate
If sblnInit Then _
sblnInit = Not sblnInit
End If
End With
End Sub
Private Sub prcMyProg()
MsgBox "Click"
End Sub
VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel
Code erstellt und getestet in Office 12
Gruß, Mullit