PAPIERAUSWAHL

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Re: PAPIERAUSWAHL

02.09.2002 19:55:34

Peter

Re: PAPIERAUSWAHL

03.09.2002 18:03:52

andre

Re: PAPIERAUSWAHL

04.09.2002 15:40:01

thomas

Hallo Thomas,
ich habe mal ein userform fuer den Druck geschrieben, Hintergrund war der Druck von den activen sheets mehrerer geoeffneter Mappen und auch auf verschiednen Druckern,davon einer mit A4 im Querformat mit Endlospapier. Für den musste die Seiteneinrichtung der Excel-Dateien geändert werden. Da hier zuweilen Diagramme aktiv waren musste auch die Zelle a1 aktiviert werden. Ansonsten wäre es ja zumindest bei "normalen" Druckern gleich aus dem Explorer gegangen. Du müsstest für Dein benutzerdefiniertes Format wie in der anderen Antwort beschrieben mal den code mit dem Makroeditor mitschneiden und einbauen - siehe die Stellen mit der Orientation in meinem code.

gruss andre

Public i%
'---------------------------------------------------------------
Sub auto_open()
'    ActiveWindow.WindowState = xlMinimized ' bei xla nicht benötigt
' Symbol anzeigen
    Application.Run ("symbol_anpassen")
End Sub
Sub los_gehts()
' 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.TextBox1.Text = "aktiver Drucker: " & Application.ActivePrinter
    UserForm1.Show

End Sub
Sub und_los()
'
    x = Workbooks.Count
' drucken - Reihenfolge wie geöffnet
    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
' alles schliessen ausser drucken.xls - Option
    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
End Sub
Sub drucken_alles()

    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
End Sub
Sub auto_close()
    On Error Resume Next
    Toolbars("Drucken-alles").Delete
    ThisWorkbook.Close SaveChanges:=False
End Sub
'---------------------------------------------------------------
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
    Application.Toolbars("Drucken-alles").ToolbarButtons(1). _
    OnAction = "los_gehts"
    With Toolbars("Drucken-alles")
    .ToolbarButtons(1).Name = "Drucken-alles"
    End With
nix:
End Sub
' **************************************************************************
' Code fuer userform
Private Sub CommandButton1_Click()
' Druckerauswahl
    dialogAntw = Application.Dialogs(xlDialogPrinterSetup).Show
    UserForm1.TextBox1.Text = "aktiver Drucker: " & Application.ActivePrinter
End Sub
Private Sub CommandButton2_Click()
' Drucken
    result = True
    Hide
    und_los
End Sub
Private Sub CommandButton3_Click()
' Beenden
    On Error Resume Next
    Toolbars("Drucken-alles").Delete
    ThisWorkbook.Close SaveChanges:=False
End Sub

Code eingefügt mit Syntaxhighlighter 1.16

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread