AW: VBA Drucklayout und UserForm
03.06.2018 23:42:33
Michael
Hallo Werner
Sorry das ich mich jetzt erst zurückmelde. Wir waren das WE zu einer Silberhochzeit eingeladen.
Vielen Dank für das MsgBox Beispiel. Manchmal erkennt man den Wald vor lauter Bäumen nicht. Noch schlimmer ist es wenn man gar keine Bäume kennt. Aber nun zum Thema.
Ich habe deinen "Drucker" Code in eine Kopie vom Original eingebunden und auch mein gemaltes Bild so wie es war mit übernommen, allerdings am Tabellenende. Die neuen Zellbezüge und Offset (jetzt 4, statt vorher 3 Spalten weiter links)habe ich auch geändert. Nur PrintPreview habe ich vorerst dringelassen, weil ich zu Hause nicht sinnlos Papier verschwenden wollte. Bei eienem ersten Test hat sich gezeigt das das ganz gut war. Das Programm wollte auch alle leeren Seiten mit ausdrucken.
Gibt es noch eine Einstellung die ich änder muß. Damit du siehst was ich geändert habe:
Option Explicit
Public Sub Drucken()
Dim loLetzte As Long, i As Long, k As Long, loAnzahl As Long
Dim ws As Worksheet, raZelle As Range, arrBlatt()
Dim strPrinterName As String, varAuswahl As Variant
strPrinterName = Application.ActivePrinter
If Range("K569") = "Ö" Then
varAuswahl = Application.Dialogs(xlDialogPrinterSetup).Show
If varAuswahl = "Falsch" Then Exit Sub
For Each ws In ThisWorkbook.Worksheets
If Right(ws.Name, 2) = "LS" Then
With ws
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.ResetAllPageBreaks
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.PageSetup.PrintArea = ""
.PageSetup.PrintArea = "A1:H" & loLetzte
For i = 48 To loLetzte Step 48
.HPageBreaks.Add Before:=.Cells(i + 1, 1)
Next i
.PrintPreview
End With
End If
Next
ElseIf WorksheetFunction.CountIf(Range("K571:K587"), "Ö") > 0 Then
varAuswahl = Application.Dialogs(xlDialogPrinterSetup).Show
If varAuswahl = "Falsch" Then Exit Sub
loAnzahl = WorksheetFunction.CountIf(Range("K571:K587"), "Ö")
ReDim Preserve arrBlatt(loAnzahl - 1)
For Each raZelle In Worksheets("Verteilung").Range("K571:K587")
If raZelle.Value = "Ö" Then
arrBlatt(k) = raZelle.Offset(, -4).Value
k = k + 1
End If
Next raZelle
For k = LBound(arrBlatt) To UBound(arrBlatt)
With Worksheets(arrBlatt(k))
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.ResetAllPageBreaks
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.PageSetup.PrintArea = ""
.PageSetup.PrintArea = "A1:H" & loLetzte
For i = 48 To loLetzte Step 48
.HPageBreaks.Add Before:=.Cells(i + 1, 1)
Next i
.PrintPreview
End With
Next k
Else
MsgBox "Es sollte schon mindestens ein Blatt" & vbLf & _
"zum Drucken ausgewählt werden."
End If
Application.ActivePrinter = strPrinterName
End Sub
Und im Tabellenblatt habe ich es folgendermaßen geändert:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address(0, 0) = "K569" Then
Cancel = True
Target = IIf(Target = "Ö", "", "Ö")
If Target = "Ö" Then Range("K571:K587").ClearContents
End If
If Not Intersect(Target, Range("K571:K587")) Is Nothing Then
Cancel = True
Target = IIf(Target = "Ö", "", "Ö")
If Target = "Ö" Then Range("K569").ClearContents
End If
If Target.Address(0, 0) = "K589" Then
Drucken
Range("K569:K587").ClearContents
Den Befehl Drucken habe ich auch einer Zelle zugewiesen statt einem CommandButton und ich habe _
noch den Befehl ClearContens angefügt weil sonst nach dem Drucken die Häkchen dringeblieben wären.
Was mir an dem Code nicht so ganz gefällt, ist das ich keine Kontrolle mehr habe wenn ich _
PrintPreview in Printout ändere. Könnte man den Code nicht dahingehend abändern das die ausgewählten Filialen (Alle oder einzeln) zu einen Sheets(Array() zusammengefasst werden und mit der Application STRG+P beendet wird. PrintPreview erfüllt zwar auch den Zweck, ist aber aufwendiger weil jede Filiale einzeln aufgerufen wird und man müsste somit 17x Drucken bestätigen.
Wieder mal viele Fragen. Danke für deine Geduld
Viele Grüße
Michael