AW: Dialogs(xlDialogPrint) ohne zu Drucken
31.10.2018 12:10:46
Dexter701
jetzt bin ich grad etwas verwirrt :/
Von welcher Zeile redest du genau?
ich hab mal den Gesamten Abschnitt eingefügt..
Nun, ich habs mal umgeschrieben das nur für den ersten Name der Dialog aufgeht.
Private Sub cmbprint_Click()
Call systemon
Dim wkstnliste As Worksheet, wksanm As Worksheet, wkscatalog As Worksheet
Dim wkszerti As Worksheet
Dim lozeile As Long, i As Long, y As Long
Dim count As Long
Dim strPassword As String, zertifikat As String
Dim strSchulung
Set wkstnliste = ThisWorkbook.Worksheets("tbl_Teilnehmerliste")
Set wksanm = ThisWorkbook.Worksheets("tbl_Anmeldung")
Set wkscatalog = ThisWorkbook.Worksheets("tbl_Schulungskatalog")
strPassword = "PW"
count = 1
If lib_termine.ListIndex = -1 Then
MsgBox "Sie haben keinen Termin ausgewählt."
Exit Sub
End If
'Kopfzeile
With wkstnliste
.Cells(3, 3) = cob_schulung
.Cells(7, 3) = uf_tnliste.lib_termine.List(lib_termine.ListIndex, 0)
.Cells(9, 3) = uf_tnliste.lib_termine.List(lib_termine.ListIndex, 1)
.Cells(9, 5) = uf_tnliste.lib_termine.List(lib_termine.ListIndex, 3)
.Cells(11, 3) = (.Cells(9, 5) - .Cells(9, 3)) * 24 & " Std."
If uf_tnliste.lib_termine.List(lib_termine.ListIndex, 0) uf_tnliste.lib_termine.List( _
lib_termine.ListIndex, 2) Then
.Cells(7, 2) = "Datum von:"
.Cells(7, 4) = "Datum bis:"
.Cells(7, 5) = uf_tnliste.lib_termine.List(lib_termine.ListIndex, 2)
Else
.Cells(7, 2) = "Datum:"
.Cells(7, 4) = ""
.Cells(7, 5) = ""
End If
y = .Cells(Rows.count, 1).End(xlUp).Row + 1
.Rows("14:" & y).Delete
End With
For i = 2 To wksanm.Cells(Rows.count, 1).End(xlUp).Row
If wksanm.Cells(i, 5) = cob_schulung Then
If wksanm.Cells(i, 8) = uf_tnliste.lib_termine.List(lib_termine.ListIndex, 5) _
Then
With wkstnliste
lozeile = .Cells(Rows.count, 1).End(xlUp).Row + 1
.Cells(lozeile, 1) = count
count = count + 1
.Cells(lozeile, 2) = wksanm.Cells(i, 1)
.Cells(lozeile, 3) = wksanm.Cells(i, 2)
.Cells(lozeile, 4) = wksanm.Cells(i, 3)
.Cells(lozeile, 5) = wksanm.Cells(i, 4)
.Cells(lozeile, 1).HorizontalAlignment = xlCenter
.Range(.Cells(lozeile, 2), .Cells(lozeile, 3)).HorizontalAlignment = _
xlHAlignLeft
.Range(.Cells(lozeile, 1), .Cells(lozeile, 3)).VerticalAlignment = _
xlCenter
.Range(.Cells(lozeile, 4), .Cells(lozeile, 5)).HorizontalAlignment = _
xlCenter
.Range(.Cells(lozeile, 4), .Cells(lozeile, 5)).VerticalAlignment = _
xlCenter
.Range(.Cells(lozeile, 1), .Cells(lozeile, 6)).BorderAround LineStyle:= _
xlContinuous
.Range(.Cells(lozeile, 1), .Cells(lozeile, 6)).Borders(xlInsideVertical) _
.LineStyle = xlContinuous
.Rows(lozeile).RowHeight = 40
End With
End If
End If
Next
ThisWorkbook.Unprotect strPassword
With wkstnliste
'Drucke Zertifikat bei bedarf
Set strSchulung = wkscatalog.Range("B:B").Find(what:=cob_schulung, LookIn:=xlValues)
If Not strSchulung Is Nothing Then
zertifikat = wkscatalog.Cells(strSchulung.Row, 5)
Set wkszerti = ThisWorkbook.Worksheets(zertifikat)
wkszerti.Visible = xlSheetVisible
wkszerti.Cells(27, 4) = .Cells(7, 3) ' Datum
wkszerti.PageSetup.BlackAndWhite = False
wkszerti.Select
For lozeile = 14 To .Cells(Rows.count, 1).End(xlUp).Row
wkszerti.Cells(20, 4) = .Cells(lozeile, 2) & "," & .Cells(lozeile, 3) 'Name
If lozeile = 14 Then
MsgBox "Bitte auf Farbdruck umstellen."
Application.Dialogs(xlDialogPrint).Show
Else
wkszerti.PrintOut
End If
Next
wkszerti.Visible = xlSheetHidden
End If
With .PageSetup
.LeftFooter = "Erstellt von: " & Application.UserName
.RightFooter = "Erstellt am: " & Date & " " & Time
.BottomMargin = Application.InchesToPoints(0.5)
.PaperSize = xlPaperA4
.BlackAndWhite = True
.PrintTitleRows = "$1:$13"
End With
.Visible = xlSheetVisible
.PrintOut
.Visible = xlSheetHidden
End With
ThisWorkbook.Protect (strPassword), Structure:=True, Windows:=True
Call systemoff
Unload Me
MsgBox "Teilnehmerliste wurde gedruckt."
End Sub