Jan Karel Pieterse-print preview

  • Thread starter Thread starter nikolaosk
  • Start date Start date
N

nikolaosk

thanks for teh response!!!!

i am glad that you see that when someone is in the print preview mode
then no macros run.

i was thinking that if i can capture the event of clicking print
preview then i could see that the user has clicked it so i could give
him a point.


can you expand a bit on the SetTimer API suggestion.



how it works and where can i find additional info?

thanks a lot in advance.
 
Hi nikolaosk
can you expand a bit on the SetTimer API suggestion.
Click to expand...

You can use this API function to start a timer that will fire a
subroutine in your code on a set interval.

BUT IT WILL DO SO REGARDLESS OF EXCEL'S STATE!!

This means that actions the macro will try to do which are normally
forbidden in that state may crash Excel.

This code may be an example of how to use the timer API:

Option Explicit

'API Declarations

Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long

Declare Function GetCurrentVbaProject Lib "vba332.dll" _
Alias "EbGetExecutingProj" _
(hProject As Long) As Long
Declare Function GetFuncID Lib "vba332.dll" Alias "TipGetFunctionId" _
(ByVal hProject As Long, ByVal
strFunctionName As String, _
ByRef strFunctionId As String) As Long
Declare Function GetAddr Lib "vba332.dll" Alias
"TipGetLpfnOfFunctionId" _
(ByVal hProject As Long, ByVal
strFunctionId As String, _
ByRef lpfn As Long) As Long
' Public Variables

Public SecondCtr As Integer
Public TimerID As Long
Public bTimerState As Boolean
Public Const lTime as long=10 'every 10 minutes

Sub TimerOn()
If bTimerState = False Then
If Left(Application.Version, 1) = "8" Then
TimerID = SetTimer(0, 0, lTime * 60000, AddrOf("YourSub"))
Else
TimerID = SetTheTimer2K
End If
If TimerID = 0 Then
MsgBox "Unable to create the timer", vbCritical +
vbOKOnly, "Error"
Exit Sub
End If
bTimerState = True
End If
End Sub

Sub TimerOff()
If bTimerState = True Then
TimerID = KillTimer(0, TimerID)
If TimerID = 0 Then
MsgBox "Unable to stop the timer", vbCritical + vbOKOnly,
"Error"
End If
bTimerState = False
End If
End Sub


Public Function AddrOf(strFuncName As String) As Long
'Returns a function pointer of a VBA public function given its name.
'AddrOf code from Microsoft Office Developer magazine
'http://www.informant.com/mod/index.htm
Dim hProject As Long
Dim lngResult As Long
Dim strID As String
Dim lpfn As Long
Dim strFuncNameUnicode As String
Const NO_ERROR = 0
' The function name must be in Unicode, so convert it.
strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
' Get the current VBA project
Call GetCurrentVbaProject(hProject)
' Make sure we got a project handle
If hProject <> 0 Then
' Get the VBA function ID
lngResult = GetFuncID(hProject, strFuncNameUnicode, strID)
If lngResult = NO_ERROR Then
' Get the function pointer.
lngResult = GetAddr(hProject, strID, lpfn)
If lngResult = NO_ERROR Then
AddrOf = lpfn
End If
End If
End If
End Function

Function SetTheTimer2K()
SetTheTimer2K = SetTimer(0, 0, lTime * 60000, AddressOf YourSub)
End Function

Regards,

Jan Karel Pieterse
Excel MVP
 
Back
Top