AW: drucken oder seitenansicht
15.01.2008 10:51:30
Nepumuk
Hallo Chris,
oder ein bisschen API-Gedöns einsetzen:
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Workbook_BeforePrint(Cancel As Boolean)
prcStartTimer
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" ( _
ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function EnumChildWindows Lib "user32.dll" ( _
ByVal hWndParent As Long, _
ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long) 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 FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Const GC_CLASSNAMEMSEXCEL = "XLMAIN"
Private Const WM_GETTEXTLENGTH As Long = &HE
Private Const WM_GETTEXT As Long = &HD
Private hWnd As Long, lngConter As Long
Private strButtonCaption As String
Public Sub prcStartTimer()
lngConter = 0
strButtonCaption = " &Weiter &Vorher &Zoom &Drucken... &Layout... &Ränder "
hWnd = FindWindow(GC_CLASSNAMEMSEXCEL, Application.Caption)
If hWnd <> 0 Then _
SetTimer hWnd, 0&, 200&, AddressOf prcTimer
End Sub
Private Sub prcStopTimer()
KillTimer hWnd, 0&
End Sub
Private Sub prcTimer(ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
On Error Resume Next
Call prcStopTimer
Call EnumChildWindows(hWnd, AddressOf fncWndEnumChildProc, 0&)
If lngConter = 6 Then
MsgBox "Seitenansicht"
Else
MsgBox "Drucken"
End If
End Sub
Public Function fncWndEnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
Dim lngReturn As Long
Dim strClassName As String * 50
Call GetClassName(hWnd, strClassName, 50)
If Left$(strClassName, InStr(strClassName & vbNullChar, vbNullChar) - 1) = "Button" Then _
If Cbool(InStr(1, strButtonCaption, fncGetText(hWnd))) Then lngConter = lngConter + 1
fncWndEnumChildProc = 1
End Function
Function fncGetText(hWnd As Long) As String
Dim lngTextlen As Long
Dim strText As String
lngTextlen = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
If lngTextlen = 0 Then Exit Function
lngTextlen = lngTextlen + 1
strText = Space(lngTextlen)
lngTextlen = SendMessage(hWnd, WM_GETTEXT, lngTextlen, ByVal strText)
fncGetText = Left$(strText, lngTextlen)
End Function
Gruß
Nepumuk