Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1544to1548
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1544to1548
1544to1548
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Druckprobleme

Druckprobleme
05.03.2017 14:53:14
Daniel
Hallo
ich habe mal wieder ein "kleines" Problem...
Application.Dialogs(xlDialogPrinterSetup).Show
wird immer nur auf das Active Sheet angewendet und von der Logik her, hat das an anderer Stelle sehr gut funktioniert, wenn ich 1 bestimmtes Sheet mit verschiedenen Inhalten füllen und jeweils drucken will...
ABER:
Jetzt versuche ich eine variable Anzahl an Sheets zu drucken und er nimmt die Einstellungen vom Printer Setup Dialog nur für das in diesem Moment aktive Blatt.

Application.Dialogs(xlDialogPrinterSetup).Show
For i = 1 To ThisWorkbook.Sheets("Runden").Range("$C$2")
Application.StatusBar = "Drucke Runde " & i
ThisWorkbook.Sheets("Runde " & i).Visible = True
ThisWorkbook.Sheets("Runde " & i).Activate
Call DruckFahrliste(ThisWorkbook.Sheets("Runde " & i), True)
ThisWorkbook.Sheets("Runden").Activate
ThisWorkbook.Sheets("Runde " & i).Visible = False
Next i


Sub DruckFahrliste(Quelle As Worksheet, Optional Direktdruck As Boolean)
Dim druckorientierung As Variant
Dim StatusEvents As Boolean
Dim StatusCalc As Long, bolScreen As Boolean
'Makrobremsen lösen
With Application
'Merken von Einstellungen - wichtig,falls dieses Ereignismakro von anderen Makros  _
getriggert wird, die die Einstellung schon geändert haben
StatusCalc = .Calculation 'Muss gemerkt werden, da 3 Werte möglich
bolScreen = .ScreenUpdating
StatusEvents = .EnableEvents
If StatusCalc  xlCalculationManual Then
.Calculate
.Calculation = xlCalculationManual
End If
If bolScreen = True Then .ScreenUpdating = False
If StatusEvents = True Then .EnableEvents = False
End With
On Error GoTo Fehler 'Diese Zeile in Kommentar umwandeln so lange das Makro entwickelt
'HIER BEGINNT DER EIGENTLICHE CODE
Quelle.Unprotect
Quelle.ResetAllPageBreaks
With Quelle.PageSetup
.RightHeader = "&R&K888888Eigentum ..."
.CenterHeader = "&C&B&I&KFF0000VERTRAULICH&I&B"
.LeftHeader = "&L&I&K888888Stand: " & Format(Now(), "DD.MM.YYYY hh:mm:ss")
.LeftFooter = "&L&K888888Abr. Monat: " & Format(ThisWorkbook.Sheets("Grunddaten").Range( _
_
"$C$13"), "00") & "/" & Format(ThisWorkbook.Sheets("Grunddaten").Range("$C$12"), "0000")
.RightFooter = "&R&K888888Seite &P von &N"
.CenterHorizontally = True
.PrintTitleRows = "$1:$5"
.PrintTitleColumns = "$E:$G"
End With
druckausrichtungalt = Quelle.PageSetup.Orientation
Quelle.PageSetup.Orientation = xlLandscape
Quelle.Range("K:N").EntireColumn.Hidden = True
Quelle.PageSetup.PrintArea = Quelle.Range("E1:O" & (5 + Quelle.Range("G3"))).Address
If Direktdruck = True Then Quelle.PrintOut Else Quelle.PrintPreview
Quelle.PageSetup.Orientation = druckausrichtungalt
Quelle.PageSetup.PrintArea = Range("E1:J50").Address
Quelle.Range("K:N").EntireColumn.Hidden = False
With Quelle.PageSetup
.LeftHeader = "&L&K888888Eigentum...
.CenterHeader = "&C&B&I&KFF0000VERTRAULICH&I&B"
.RightHeader = ""
.LeftFooter = ""
.RightFooter = "&R&K888888Seite &P von &N"
.CenterHorizontally = True
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Quelle.Protect
'ENDE DES EIGENTLICHEN CODES
Fehler:
'Fehlerbehandlung
With Err
Select Case .Number
Case 0 'alles OK
Case Else
MsgBox "Fehler-Nr..: " & .Number & vbLf & .Description
End Select
End With
'Makrobremsen zurücksetzen
With Application
If bolScreen  .ScreenUpdating Then .ScreenUpdating = bolScreen
If StatusCalc  .Calculation Then
.Calculation = StatusCalc
.Calculate
End If
If StatusEvents  .EnableEvents Then
.EnableEvents = StatusEvents
End If
End With
End Sub
ich will die Abfrage aber auch nicht für jedes Blatt einzeln machen...
ich hoffe jemand kann mir Helfen.
Danke schon einmal im Voraus
Schönen Sonntag noch
Daniel

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

Betreff
Datum
Anwender
Anzeige
AW: Druckprobleme
05.03.2017 18:30:31
Daniel
Ich habe mal noch etwas weitergebastelt... Die Sub wird nun mit einer Liste von Sheetnamen aufgerufen ...
Sub DruckFahrliste(WSNamen As String, Optional Direktdruck As Boolean)
Dim Blaetter() As String
Blaetter() = Split(WSNamen, ";")
Dim druckorientierung As Variant
Dim BlattName As Variant
Dim BlattNr As Integer
Dim StatusEvents As Boolean
Dim StatusCalc As Long, bolScreen As Boolean
Dim strPrinterName As String
Dim strPrinterNameCheck As String
Dim varRueckgabe As Variant
'Makrobremsen lösen
With Application
'Merken von Einstellungen - wichtig,falls dieses Ereignismakro von anderen Makros  _
getriggert wird, die die Einstellung schon geändert haben
StatusCalc = .Calculation 'Muss gemerkt werden, da 3 Werte möglich
bolScreen = .ScreenUpdating
StatusEvents = .EnableEvents
If StatusCalc  xlCalculationManual Then
.Calculate
.Calculation = xlCalculationManual
End If
If bolScreen = True Then .ScreenUpdating = False
If StatusEvents = True Then .EnableEvents = False
End With
On Error GoTo Fehler 'Diese Zeile in Kommentar umwandeln so lange das Makro entwickelt
'HIER BEGINNT DER EIGENTLICHE CODE
ThisWorkbook.Sheets("Runden").Select
BlattNr = 0
ReDim druckausrichtungalt(1 To UBound(Blaetter) + 1)
For Each BlattName In Blaetter
BlattNr = BlattNr + 1
Set Quelle = ThisWorkbook.Sheets(BlattName)
Application.StatusBar = "Setze Standarteinstellungen für " & Quelle.Name
Quelle.Unprotect
Quelle.PageSetup.PrintArea = Quelle.Range("E1:O" & (5 + Quelle.Range("G3"))).Address
Quelle.ResetAllPageBreaks
With Quelle.PageSetup
If .RightHeader  "&R&K888888Eigentum des Sproitzer Dorfkrug" Then .RightHeader = "&R& _
K888888Eigentum des Sproitzer Dorfkrug"
If .CenterHeader  "&C&B&I&KFF0000VERTRAULICH&I&B" Then .CenterHeader = "&C&B&I& _
KFF0000VERTRAULICH&I&B"
.LeftHeader = "&L&I&K888888Stand: " & Format(Now(), "DD.MM.YYYY hh:mm:ss")
.LeftFooter = "&L&K888888Abr. Monat: " & Format(ThisWorkbook.Sheets("Grunddaten").Range( _
"$C$13"), "00") & "/" & Format(ThisWorkbook.Sheets("Grunddaten").Range("$C$12"), "0000")
If .RightFooter  "&R&K888888Seite &P von &N" Then .RightFooter = "&R&K888888Seite &P  _
von &N"
If .CenterHorizontally = False Then .CenterHorizontally = True
.PrintTitleRows = "$1:$5"
.PrintTitleColumns = ""
End With
druckausrichtungalt(BlattNr) = Quelle.PageSetup.Orientation
Quelle.PageSetup.Orientation = xlLandscape
Quelle.Range("K:N").EntireColumn.Hidden = True
Next BlattName
Application.StatusBar = "Erzeuge Druckauftrag"
'zu Testzwecken
'Direktdruck = False
If Direktdruck = True Then
ThisWorkbook.Sheets(Blaetter).Select
strPrinterName = Application.ActivePrinter
Call MsgBox("WICHTIG" + vbNewLine + vbNewLine + "Mit 'Optionen' die Einstellungen für den  _
Duplex-Druck prüfen!", vbCritical, "DUPLEX-Druck")
Do
strPrinterNameCheck = Application.ActivePrinter
varRueckgabe = Application.Dialogs(xlDialogPrinterSetup).Show
If varRueckgabe = False Then GoTo Ende
Loop Until Application.ActivePrinter = strPrinterNameCheck
ThisWorkbook.Sheets(Blaetter).PrintOut
Application.ActivePrinter = strPrinterName
Else
Application.ScreenUpdating = True
ThisWorkbook.Sheets(Blaetter).PrintPreview
Application.ScreenUpdating = False
End If
Ende:
ThisWorkbook.Sheets("Runden").Select
BlattNr = 0
For Each BlattName In Blaetter
BlattNr = BlattNr + 1
Set Quelle = ThisWorkbook.Sheets(BlattName)
Application.StatusBar = "Setze Standarteinstellungen für " & Quelle.Name & " zurück"
Quelle.PageSetup.Orientation = druckausrichtungalt(BlattNr)
Quelle.PageSetup.PrintArea = Quelle.Range("E1:J50").Address
Quelle.Range("K:N").EntireColumn.Hidden = False
With Quelle.PageSetup
'.RightHeader = "&L&K888888Eigentum des Sproitzer Dorfkrug"
'.CenterHeader = "&C&B&I&KFF0000VERTRAULICH&I&B"
.LeftHeader = ""
.LeftFooter = ""
'.RightFooter = "&R&K888888Seite &P von &N"
'.CenterHorizontally = True
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Quelle.Protect
Next BlattName
ThisWorkbook.Sheets(Blaetter).Visible = False
Sheets("Runden").Select
'ENDE DES EIGENTLICHEN CODES
Fehler:
'Fehlerbehandlung
With Err
Select Case .Number
Case 0 'alles OK
Case Else
MsgBox "Fehler-Nr..: " & .Number & vbLf & .Description
End Select
End With
Application.StatusBar = False
'Makrobremsen zurücksetzen
With Application
If bolScreen  .ScreenUpdating Then .ScreenUpdating = bolScreen
If StatusCalc  .Calculation Then
.Calculation = StatusCalc
.Calculate
End If
If StatusEvents  .EnableEvents Then
.EnableEvents = StatusEvents
End If
End With
End Sub

Zwei Probleme ... immernoch ... die Einstellungen über den PrinterSetupDialog werden immernoch nur auf die erste Seite angewendet. Das Setzen der PageSetups für jedes Sheet einzeln dauert unheimlich lange...
Anzeige
AW: Probleme bei der Druckeransteuerung
06.03.2017 12:00:11
Daniel
Ich habe jetzt mal weiter getestet und das printout mal rausgenommen und generell über printpreview...
Ich habe in der Druckvorschau alle Seiten in einem PrintJob (in dem Beispiel 14) und kann Drucker, Papier, Schacht etc. auswählen ... ABER: in der Druckerwarteschlange sind es dann plötzlich 2 Aufträge (1x mit 3 Seiten und 1x mit 11 Seiten). Excel (oder der Druckertreiber) zerhackt den Auftrag weil bei einem Teil der Worksheets Recyclingpapier und bei dem anderen Teil Normalpapier als Druckmedium eingestellt ist...
Es gibt sicher sinnvolle Verwendung, dass jedes Blatt mit seinen spezifischen Einstellungen gedruckt wird, aber mir hilft es leider nicht. Wofür gibt es "application.activeprinter" wenn diese Einstellung nicht für die komplette Anwendung gilt?
Ich hoffe, dass sich noch eine Lösung findet.
Grüße
Daniel
Anzeige
AW: Druckprobleme
06.03.2017 16:43:39
Daniel
So ... Ihr könnt aufhören zu knobeln ... ich habe es mit einem neuen Ansatz selbst zum Laufen bekommen...
Ich habe ein verstecktes Druckmuster-Blatt angelegt (dass muss auch nicht ständig neu formatiert werden). Wenn alle Formatierungen stehen und auch die Druckeinstellungen für das Blatt gesetzt sind, wird das Blatt temporär kopiert und mit den Inhalten der zu druckenden Blätter gefüllt. In den Kopien werden dann nur noch die einzelnen Druckbereiche gesetzt und die Blätter allesamt als ein Auftrag gedruckt...
Der Code ist sicherlich eleganter machbar, aber ich bin erst einmal froh, dass es läuft... und ich hatte befürchtet, dass das Kopieren sehr lange dauert - aber es geht schneller als das alte Script in dem für jedes Blatt die PageSetup(s) gesetzt wurden...
Sub DruckFahrliste(WSNamen As String, Optional Direktdruck As Boolean)
Dim Blaetter() As String
Dim DruckBlaetter() As String
Dim BlattName As Variant
Dim DruckBlattName As Variant
Dim StatusEvents As Boolean
Dim StatusCalc As Long, bolScreen As Boolean
Dim strPrinterName As String
Dim strPrinterNameCheck As String
Dim varRueckgabe As Variant
Dim Quelle As Worksheet
Dim Ziel As Worksheet
Dim DruckVorlage As Worksheet
Dim Blatt As Worksheet
Dim vorhanden As Boolean
'Makrobremsen lösen
With Application
'Merken von Einstellungen - wichtig,falls dieses Ereignismakro von anderen Makros  _
getriggert wird, die die Einstellung schon geändert haben
StatusCalc = .Calculation 'Muss gemerkt werden, da 3 Werte möglich
bolScreen = .ScreenUpdating
StatusEvents = .EnableEvents
If StatusCalc  xlCalculationManual Then
.Calculate
.Calculation = xlCalculationManual
End If
If bolScreen = True Then .ScreenUpdating = False
If StatusEvents = True Then .EnableEvents = False
End With
On Error GoTo FehlerFLD 'Diese Zeile in Kommentar umwandeln so lange das Makro entwickelt
'HIER BEGINNT DER EIGENTLICHE CODE
Blaetter() = Split(WSNamen, ";")
Set DruckVorlage = ThisWorkbook.Sheets("RundeDruck")
ThisWorkbook.Sheets("Runden").Select
DruckVorlage.Visible = xlSheetVisible
DruckVorlage.Select
DruckVorlage.Unprotect
DruckVorlage.ResetAllPageBreaks
DruckVorlage.Range("K:N").EntireColumn.Hidden = True
With DruckVorlage.PageSetup
If .RightHeader  "&R&K888888Eigentum des Sproitzer Dorfkrug" Then .RightHeader = "&R& _
K888888Eigentum des Sproitzer Dorfkrug"
If .CenterHeader  "&C&B&I&KFF0000VERTRAULICH&I&B" Then .CenterHeader = "&C&B&I& _
KFF0000VERTRAULICH&I&B"
If .LeftHeader = "&L&I&K888888Stand: " & Format(Now(), "DD.MM.YYYY hh:mm:ss") Then . _
LeftHeader = "&L&I&K888888Stand: " & Format(Now(), "DD.MM.YYYY hh:mm:ss")
If .LeftFooter  "&L&K888888Abr. Monat: " & Format(ThisWorkbook.Sheets("Grunddaten"). _
Range("$C$13"), "00") & "/" & Format(ThisWorkbook.Sheets("Grunddaten").Range("$C$12"), "0000") Then .LeftFooter = "&L&K888888Abr. Monat: " & Format(ThisWorkbook.Sheets("Grunddaten").Range("$C$13"), "00") & "/" & Format(ThisWorkbook.Sheets("Grunddaten").Range("$C$12"), "0000")
If .RightFooter  "&R&K888888Seite &P von &N" Then .RightFooter = "&R&K888888Seite &P  _
von &N"
If .CenterHorizontally = False Then .CenterHorizontally = True
If .PrintTitleRows  "$1:$5" Then .PrintTitleRows = "$1:$5"
If .PrintTitleColumns  "" Then .PrintTitleColumns = ""
If .FitToPagesWide  1 Then .FitToPagesWide = 1
If .Orientation  xlLandscape Then .Orientation = xlLandscape
End With
'zu Testzwecken - sonst auskommentieren
'Direktdruck = False
If Direktdruck = True Then
strPrinterName = Application.ActivePrinter
Call MsgBox("WICHTIG" + vbNewLine + vbNewLine + "Mit 'Optionen' die Einstellungen für den  _
Duplex-Druck prüfen!", vbCritical, "DUPLEX-Druck")
Do
strPrinterNameCheck = Application.ActivePrinter
varRueckgabe = Application.Dialogs(xlDialogPrinterSetup).Show
If varRueckgabe = False Then GoTo Ende
Loop Until Application.ActivePrinter = strPrinterNameCheck
Else
'weiter unten
End If
For Each BlattName In Blaetter
Set Quelle = ThisWorkbook.Sheets(BlattName)
Application.StatusBar = "Setze Standarteinstellungen für " & Quelle.Name
vorhanden = False
For Each Blatt In Sheets
If Blatt.Name = "Druck" & BlattName Then vorhanden = True
Next Blatt
If vorhanden = True Then
ThisWorkbook.Sheets("Druck" & BlattName).Visible = xlSheetVisible
Application.DisplayAlerts = False
ThisWorkbook.Sheets("Druck" & BlattName).Delete
Application.DisplayAlerts = True
End If
DruckVorlage.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Druck" & BlattName
Set Ziel = ActiveSheet
Ziel.Range("$E$1:$O$51").Value = Quelle.Range("$E$1:$O$51").Value
On Error GoTo weiter
If UBound(DruckBlaetter) >= 0 Then
ReDim Preserve DruckBlaetter(UBound(DruckBlaetter) + 1)
DruckBlaetter(UBound(DruckBlaetter)) = Ziel.Name
End If
weiter:
With Err
Select Case .Number
Case 0 'alles OK
Case 9 'Array nicht dimensioniert
ReDim DruckBlaetter(0)
DruckBlaetter(0) = Ziel.Name
Case Else 'restliche Fehlerbehandlung
GoTo FehlerFLD
End Select
End With
On Error GoTo FehlerFLD
Ziel.PageSetup.PrintArea = Ziel.Range("E1:O" & (5 + Ziel.Range("G3"))).Address
Next BlattName
Application.StatusBar = "Erzeuge Druckauftrag"
'nur zum Testen - sonst auskommentieren
'Direktdruck = False
If Direktdruck = True Then
ThisWorkbook.Sheets(DruckBlaetter).PrintOut
Application.ActivePrinter = strPrinterName
Else
Application.ScreenUpdating = True
ThisWorkbook.Sheets(DruckBlaetter).PrintPreview
Application.ScreenUpdating = False
End If
Application.DisplayAlerts = False
ThisWorkbook.Sheets(DruckBlaetter).Delete
Application.DisplayAlerts = False
Ende:
ThisWorkbook.Sheets("Runden").Select
DruckVorlage.Protect
DruckVorlage.Visible = xlSheetHidden
ThisWorkbook.Sheets(Blaetter).Visible = False
ThisWorkbook.Sheets("Runden").Select
'ENDE DES EIGENTLICHEN CODES
FehlerFLD:
'Fehlerbehandlung
With Err
Select Case .Number
Case 0 'alles OK
Case Else
MsgBox "Fehler-Nr..: " & .Number & vbLf & .Description
End Select
End With
Application.StatusBar = False
'Makrobremsen zurücksetzen
With Application
If bolScreen  .ScreenUpdating Then .ScreenUpdating = bolScreen
If StatusCalc  .Calculation Then
.Calculation = StatusCalc
.Calculate
End If
If StatusEvents  .EnableEvents Then
.EnableEvents = StatusEvents
End If
End With
End Sub
Falls noch jemand Tipps hat oder Schwachstellen findet, bin ich über eine Nachricht dankbar.
Bis dahin
Daniel
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige