Drucken per UserForm
04.10.2006 20:24:40
Sebastian
bin am Ende mit meinem Latain und suche mal wieder Hilfe im Forum. Ich habe mir eine kleine UserForm mit einer Listbox gebaut und möchte jetzt über die Auswahl der Listbox bestimmte Tabellenblätter ausdrucken. Das Makro läuft, allerdings bleit es bei der Druckvorschau hängen und Excel hängt sich auf. Hoffe es kann mir jemand helfen. Vielleicht hat jemand eine Idee. Danke.
Grüße Sebastian.
Option Explicit
Private Sub CommandButton1_Click()
Sheets("Control").Cells(1, 3) = txPrint.Value
Call BEREICH_Print_BENENNEN
Call Print_NomiList
Unload Me
Sheets(1).Select
Sheets(1).Range("A1").Select
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub lsPrint_Click()
Dim r As Range
Dim i%
Dim arrPrint As String
i = lsPrint.ListIndex + 1
Set r = ThisWorkbook.Sheets("Control").Range("Name")
txPrint.Value = r.Cells(i, 1).Value
txPrint.Value = lsPrint.Text
Sheets("Control").Cells(14, 17) = txPrint.Value
End Sub
Private Sub UserForm_Initialize()
'Initialize Listbox.
With UserForm1.lsPrint
.MultiSelect = fmMultiSelectSingle
.RowSource = "Name"
.ListIndex = 0
End With
End Sub
'Der Druckbereich auf dem ausgewählten Blatt wird definiert.
Public Sub BEREICH_Print_BENENNEN()
Dim lastRow As Long
Dim wks As Worksheet
Dim bereich As Range
'Set wks = Sheets(CStr(Range("Q14")))
'Sheets(CStr(Range("Q14"))).Visible = True
lastRow = IIf(Sheets(CStr(Range("Q14"))).Range("AG65536") "", 65536, _
Sheets(CStr(Range("Q14"))).Range("AG65536").End(xlUp).Row)
Set bereich = Sheets(CStr(Range("Q14"))).Range("B2:V" & lastRow)
ActiveWorkbook.Names.Add _
Name:="NomiList_PrintFile", _
RefersTo:=bereich, Visible:=True
'Sheets(CStr(Range("Q14"))).Visible = False
End Sub
Sub Print_NomiList()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Sheets(CStr(Range("Q14"))).Visible = True
'Sheets(CStr(Range("Q14"))).Select
'Sheets(CStr(Range("Q14"))).Activate
'ActiveSheet.Unprotect
'Call BEREICH_Print_BENENNEN
ActiveSheet.PageSetup.PrintArea = ""
ActiveSheet.PageSetup.PrintArea = "NomiList_PrintFile"
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "NomiList_PrintFile"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&Z&F"
.CenterFooter = "IBM Confidential"
.RightFooter = "&D&T"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
'.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintPreview
ActiveSheet.Unprotect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
Sheets(CStr(Range("Q14"))).Visible = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub