Hallo Marco,
hier ist ein altes Makro von mir (zum Teil noch in Wordbasic), das das
Gewünschte leistet. Name des Druckers und der Schächte müssen noch
angepasst werden.
Sub DruckenAusZweiKassetten()
' Dieses Makro ist speziell an die KYOCERA-Laserdrucker der Baureihe
' FS-1500/1550/1600 angepaßt und zieht das Papier in der gewünschten
Anzahl
' sowohl aus der oberen Kassette ( Briefpapier ) als auch der unteren
' ( Blanco, Standard ) ein.
Dim Button As Integer
' Ist überhaupt ein Dokument geöffnet ?
If Documents.count = 0 Then
MsgBox "Nix da zum Drucken ...", vbExclamation + vbOKOnly
Exit Sub
End If
Application.ScreenUpdating = False
' Beginn des Benutzerdialogfeldes :
WordBasic.BeginDialog 300, 220, "Drucken aus zwei Kassetten"
WordBasic.Text 8, 12, 180, 8, "Anzahl &Briefbogen"
WordBasic.TextBox 210, 12, 30, 18, "Briefpapier$"
WordBasic.Text 8, 40, 180, 18, "Anzahl B&lancoblätter"
WordBasic.TextBox 210, 40, 30, 18, "Blanco$"
WordBasic.GroupBox 8, 70, 200, 105, "Dokument schließen"
WordBasic.OptionGroup "Schließen"
WordBasic.OptionButton 30, 90, 150, 18, "&mit speichern"
WordBasic.OptionButton 30, 118, 150, 18, "&ohne speichern"
WordBasic.OptionButton 30, 146, 150, 18, "nicht sch&ließen"
WordBasic.OKButton 25, 190, 120, 21
WordBasic.CancelButton 155, 190, 120, 21
WordBasic.EndDialog
' Meldung ausgeben :
StatusBar = String(38, " ") + "Mit TAB von Feld zu Feld springen, n i
c h t mit der Eingabetaste !"
' Einlesen der Benutzereingaben, Vorbesetzungen :
Dim dlg As Object: Set dlg = WordBasic.CurValues.UserDialog
dlg.Briefpapier$ = "1"
dlg.Blanco$ = "0"
dlg.Schließen = 2
Button = WordBasic.Dialog.UserDialog(dlg)
' "Abbrechen" ausgewählt ?
If Button = 0 Then Exit Sub
' Drucker auf KYOCERA einstellen :
' ActivePrinter = "Kyocera FS-1550+"
' Zuerst Briefpapier aus der oberen Kassette einziehen :
If Val(dlg.Briefpapier$) > 0 Then
WordBasic.ToolsOptionsPrint DefaultTray:="Kassette 1 (intern)"
WordBasic.FilePrint Range:=0, Type:=0,
NumCopies:=Val(dlg.Briefpapier$)
End If
' Dann Blancopapier aus der unteren Kassette einziehen :
WordBasic.ToolsOptionsPrint DefaultTray:="Kassette 2"
If Val(dlg.Blanco$) > 0 Then
WordBasic.FilePrint Range:=0, Type:=0, NumCopies:=Val(dlg.Blanco$)
End If
' schließen / speichern ?
Select Case dlg.Schließen
Case 0
' schließen + speichern :
On Error Resume Next
ActiveDocument.Close SaveChanges:=wdSaveChanges
Case 1
' schließen, ohne zu speichern :
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
Case 2
' nicht schließen, keine Aktion :
End Select
End Sub
Viele Grüße vom Niederrhein
Lutz, MVP für Word/VBA