Sub Click(Source As Button) Dim Doc As NotesDocument Dim Handle As Variant Dim PrintRet As Integer Dim Delay As Long On Error Goto Errhandle Delay = 3 If Doc.HasEmbedded Then Dim RTItem As Variant Set RTItem = Doc.GetFirstItem( "Body" ) If ( RTItem.Type = RICHTEXT ) Then If Not Isempty(RTItem.EmbeddedObjects) Then Forall Obj In RTItem.EmbeddedObjects If ( Obj.Type = EMBED_OBJECT ) Then If Obj.Class = "Excel.Sheet.5" Or Obj.Class = "Excel.Sheet.8" Or Obj.Class = "ExcelWorksheet" Then Set Handle = Obj.Activate( True ) If ( Handle Is Nothing ) Then Messagebox "Invalid OLE interface" Exit Sub Else Handle.Application.Assistant.Visible = False 'Handle.Application.Visible = False Handle.Application.DisplayAlerts = True Dim x As Integer For x=1 To handle.Application.ActiveWorkbook.Sheets.Count Handle.Application.ActiveWorkbook.Sheets(x).PageSetup.PrintGridlines = 1 Handle.Application.ActiveWorkbook.Sheets(x).PageSetup.Printheadings = 1 Handle.Application.ActiveWorkbook.Sheets(x).PageSetup.Printnotes = 1 Next PrintRet = 1 PrintRet = Handle.Application.ActiveWorkbook.PrintOut( , , , 0, , , , ) Delay = 3 * Handle.Application.ActiveWorkbook.Sheets.Count ' Zahl nach eigene ermessen anpassen. Sleep Delay Call Handle.Application.ActiveWorkbook.Close(False) Call Handle.Application.Quit() If PrintRet = 1 Then Messagebox "Object """ & Obj.Source & """ is not printed" End If End If End If End If End Forall End If End If End If Exit Sub Errhandle: Messagebox "Error " & Err & " " & Error Exit Sub End Sub