ich weiß es nicht, aber ich würde den Makrorecorder einschalten und dann über "Seite einrichten" das gewünschte Papierformat einstellen und mir dann den VBA-Code ansehen, der sicher noch angepasst werden muss.
Gruss
Peter
gruss andre
End Sub Sub los_gehts() UserForm1.TextBox1.Text = "aktiver Drucker: " & Application.ActivePrinter Sub und_los() ' drucken - Reihenfolge wie geöffnet ' alles schliessen ausser drucken.xls - Option End Sub Sub drucken_alles() End Sub Sub auto_close() End Sub '--------------------------------------------------------------- Application.Toolbars("Drucken-alles").ToolbarButtons(1). _ With Toolbars("Drucken-alles") nix: dialogAntw = Application.Dialogs(xlDialogPrinterSetup).Show End Sub Private Sub CommandButton2_Click() End Sub Private Sub CommandButton3_Click() End Sub
Code eingefügt mit Syntaxhighlighter 1.16
Public i%
'---------------------------------------------------------------
Sub auto_open()
' ActiveWindow.WindowState = xlMinimized ' bei xla nicht benötigt
' Symbol anzeigen
Application.Run ("symbol_anpassen")
' userform Drucker eintragen und anzeigen
' userform mit 3 Schaltflaechen zur Druckerwahl, Druck und Beenden,
' 2 checkboxen fuer Wechsel Hoch/Querformat, Dateien nach Druck Schliessen
' 2 Option-Button in frame für Wechsel Druckreihenfolge
UserForm1.Show
End Sub
'
x = Workbooks.Count
If UserForm1.OptionButton1 = True Then
For i = 1 To x
If i > 0 Then drucken_alles
Next i
Else
' drucken - Reihenfolge umgekehrt wie geöffnet
For i = x To 1 Step -1
If i > 0 Then drucken_alles
Next i
End If
If UserForm1.CheckBox1 = True Then
For i = 1 To x
If ActiveWorkbook.Name <> "Drucken.xls" Then
ActiveWindow.Close SaveChanges:=False
End If
Next i
End If
Workbooks(i).Activate
[a1].Select
' ist_orientation = ActiveSheet.PageSetup.Orientation
' If ActiveSheet.PageSetup.Orientation = xlPortrait Then
' MsgBox "Orientierung ist xlPortrait"
' MsgBox ist_orientation
' Else
' MsgBox "Orientiierung ist xlLandscape"
' MsgBox ist_orientation
' End If
If ActiveWorkbook.Name <> "Drucken.xls" Then
aktiverdrucker = Application.ActivePrinter
posdruck = InStr(1, aktiverdrucker, 3000, 0)
' Drucken auf Epson 3000 Endlos Querformat
If posdruck > 0 And UserForm1.CheckBox2 = True Then
If ActiveSheet.PageSetup.Orientation = 2 Then
With ActiveSheet.PageSetup
.Orientation = xlPortrait
End With
Else
With ActiveSheet.PageSetup
.Orientation = xlLandscape
End With
End If
ActiveWindow.SelectedSheets.PrintOut Copies:=1
' Orientierung ückgängig, falls weiterer Druck geplant ist
' bzw. Datei nicht geschlossen wird
If ActiveSheet.PageSetup.Orientation = 2 Then
With ActiveSheet.PageSetup
.Orientation = xlPortrait
End With
Else
With ActiveSheet.PageSetup
.Orientation = xlLandscape
End With
End If
' Drucken auf anderem Drucker
Else
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End If
' Application.ActivePrinter = "\\xxx.xxx.xxx.xxx\HP_LJ4 auf Ne03:"
' ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"\\xxx.xxx.xxx.xxx\HP_LJ4 auf Ne03:", Collate:=True
End If
On Error Resume Next
Toolbars("Drucken-alles").Delete
ThisWorkbook.Close SaveChanges:=False
Sub Symbol_anpassen()
On Error Resume Next
Toolbars("Drucken-alles").Delete
On Error GoTo nix
With Application
.ShowToolTips = True
.LargeButtons = False
.ColorButtons = True
End With
Toolbars.Add Name:="Drucken-alles"
On Error GoTo nix
Toolbars("Drucken-alles").ToolbarButtons. _
Add Button:=210 + i, Before:=1
With Toolbars("Drucken-alles")
.Visible = True
.Position = xlTop
.Left = 649
.Top = 45
End With
ThisWorkbook.Sheets("Symbol").DrawingObjects("symbol2").Copy
Toolbars("Drucken-alles").ToolbarButtons(1). _
PasteFace
OnAction = "los_gehts"
.ToolbarButtons(1).Name = "Drucken-alles"
End With
End Sub
' **************************************************************************
' Code fuer userform
Private Sub CommandButton1_Click()
' Druckerauswahl
UserForm1.TextBox1.Text = "aktiver Drucker: " & Application.ActivePrinter
' Drucken
result = True
Hide
und_los
' Beenden
On Error Resume Next
Toolbars("Drucken-alles").Delete
ThisWorkbook.Close SaveChanges:=False
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen