Rubrik: Excel | VB-Versionen: VBA | 06.07.04 |
WorkAfterPrint-Ereignis in Excel Ergänzt das Excel Applikations Objekt um ein WorkbookAfterPrint Ereignis | ||
Autor: Mark Boland | Bewertung: | Views: 15.550 |
www.data-object.de | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | kein Beispielprojekt |
Es gibt im Excel-Application-Object ein WorkbookBeforePrint-Ereignis. Dieses wird ausgelöst, wenn man in die Vorschau-Ansicht, direkt in den Druck oder aber in den Druckdialog geht. Die Vorschau und den Druckdialog kann man aber auch mit "Abbrechen" verlassen, und somit weiss man im Nachhinein nicht, ob gedruckt wurde oder nicht und wann. Ein WorkbookAfterPrint-Ereignis, was bei einem echten Druck ausgelöst wird, wäre also wesentlich besser.
Dazu die beiliegende Klasse clsExcelAfterPrint, s.u.
Starten. Die Klasse braucht noch ein Form-Objekt mit einem Timer-Control und ein instanziertes Excel. Beide werden der Klasse zugewiesen. PrintWatch.Start startet die Excel-Überwachung und liefert das Ereignis. Nach PrintWatch.StopIt wird auch das Ereignis nicht mehr geliefert.
Beipiel:
Dim WithEvents PrintWatch As clsExcelAfterPrint ... ... ... Set objExcel = CreateObject("Excel.Application", "") ... Set PrintWatch = New clsExcelAfterPrint Set PrintWatch.objApp = objExcel Set PrintWatch.objTimer = formMain.TimerPrintWatch ... ... ... PrintWatch.Start ' In diesem Zeitraum wird das Ereignis geliefert PrintWatch.StopIt ' Ab hier dann nicht mehr
Private Sub PrintWatch_WorkbookAfterPrint() PrintWatch.StopIt ' Mache dies und das, und weiter PrintWatch.Start End Sub
Das Klassenmodul clsExcelAfterPrint
' ----------------------------------------- ' clsExcelAfterPrint ' ----------------------------------------- Dim LastPrintDate As Date Dim BeforePrintDate As Date Dim ModeStart As Boolean Public WithEvents objApp As excel.Application Public WithEvents objTimer As Timer Public Event WorkbookAfterPrint()
Public Sub Start() ' Timer aus, Interval 3 Sekunden ModeStart = True objTimer.Enabled = False objTimer.Interval = 3000 BeforePrintDate = CDate("01.01.1900") End Sub
Public Sub StopIt() ModeStart = False End Sub
Private Sub objApp_NewWorkbook(ByVal Wb As excel.Workbook) BeforePrintDate = CDate("01.01.1900") End Sub
Private Sub objApp_WorkbookBeforePrint( _ ByVal Wb As excel.Workbook, Cancel As Boolean) If ModeStart = True Then ' Eine Sekunde abziehen falls der Druck unter eine Sekunde dauert BeforePrintDate = DateAdd("s", -1, Now) objTimer.Enabled = True End If End Sub
Private Function GetLastPrintDate() As Date On Error GoTo Fehler ' Letztes Druckdatum merken With objApp.ActiveWorkbook ' Index 10 GetLastPrintDate = .BuiltinDocumentProperties("Last print date") End With Exit Function Fehler: ' Wenn Fehler, dann war Druckdatum leer. ' Dann auf Vergangenheit setzen. GetLastPrintDate = Now - 1 End Function
Private Sub objApp_WorkbookOpen(ByVal Wb As excel.Workbook) BeforePrintDate = CDate("01.01.1900") End Sub
Private Sub objTimer_Timer() If Not (BeforePrintDate = CDate("01.01.1900")) Then If GetLastPrintDate > BeforePrintDate Then ' Timer aus, Datum Init und Event abschicken objTimer.Enabled = False BeforePrintDate = CDate("01.01.1900") RaiseEvent WorkbookAfterPrint End If End If End Sub