Userform - Drucken
29.02.2008 10:45:03
André
habe diesen Befehl von Nepumuk erhalten, der funktioniert auch,
allerdings gibt es leider noch ein paar Funktionen die nicht laufen und ich alleine nicht hinbekomme.
Ich habe ein Userform zum drucken. Allerdings funktionieren die u.g. Funktionen eingeschränkt oder eben garnicht.
Habe noch eine Datei angehängt: https://www.herber.de/bbs/user/50292.xls
Folgende Funktionen sind davon betroffen...
Anzahl Exemplare
Wenn hier die Anzahl angegeben wurde sowie die restlichen Angaben gemacht wurden müsste der Druckbutton freigegeben werden, allerdings bleibt dieser immer deaktiviert.
Von Seite / Bis Seite
Ich kann die Von Bis Seiten noch nicht auswählen, hier fehlen noch
die Seitenzahlen 1-10.
Blätter
Zum anderen möchte ich in diesem Fall die Blätter Hans, Peter, Max anzeigen lassen. Das entspräche Tabelle 1, 2, 3. Die Tabellennamen ändern sich stetig.
' **********************************************************************
' Modul: Drucken Typ: Userform
' **********************************************************************
Option Explicit
Private Declare Function DeviceCapabilities Lib "winspool.drv" Alias "DeviceCapabilitiesA" ( _
ByVal lpDeviceName As String, _
ByVal lpPort As String, _
ByVal iIndex As Long, _
ByRef lpOutput As Any, _
ByVal dev As Long) As Long
Private Const DC_PAPERS As Long = 2&
Private Const DC_PAPERNAMES As Long = 16&
Private Sub UserForm_Initialize()
Dim objWorksheet As Worksheet
AktiverDrucker.Caption = Application.ActivePrinter
Call prcShowPaperSize
For Each objWorksheet In ThisWorkbook.Worksheets
If Left$(objWorksheet.Name, 11) "Überflüssig" Then _
cbbBlaetter.AddItem objWorksheet.Name
Next
ComboBox1.List = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode vbFormCode Then
MsgBox "Beenden? - Gibt doch so´n Butten wo Abbrechen draufsteht... ;-))", _
vbInformation, "Hinweis"
Cancel = True
End If
End Sub
Private Sub cmbCancel_Click()
Unload Me
End Sub
Private Sub cbtDruck_Click()
Dim Blattname As String
Dim Druck As String
Dim Von As String
Dim Bis As String
Dim LoI As Long
For LoI = 0 To cbbBlaetter.ListCount - 1
If cbbBlaetter.Selected(LoI) Then
Blattname = cbbBlaetter.List(LoI)
Druck = txbAnzEx
Von = txtVon
Bis = txtBis
If txtVon = "" Then
Sheets(Blattname).Range("A1:N" & Cells(Rows.Count, 2).End(xlUp).Row). _
PrintOut Copies:=Druck
Else
Sheets(Blattname).Range("A1:N" & Cells(Rows.Count, 2).End(xlUp).Row). _
PrintOut From:=Von, to:=Bis, Copies:=Druck
End If
End If
Next LoI
Unload Me
End Sub
Private Sub cmbDrWechsel_Click()
Me.Hide
Application.Dialogs(xlDialogPrinterSetup).Show
AktiverDrucker.Caption = Application.ActivePrinter
Call prcShowPaperSize
Me.Show
End Sub
Private Sub txbAnzEx_Change()
cbtDruck.Enabled = True
End Sub
Private Sub prcShowPaperSize()
Dim intPaperCount As Integer
Dim lngPapers As Long, lngPaperNumbers() As Long
Dim strPaperName As String, strPaperList As String
Dim strDeviceName As String, strPort As String
strDeviceName = Trim$(Split(Application.ActivePrinter, "auf")(0))
strPort = Trim$(Split(Application.ActivePrinter, "auf")(1))
ComboBox4.Clear
lngPapers = DeviceCapabilities(strDeviceName, strPort, DC_PAPERS, ByVal vbNullString, 0&)
If lngPapers > 0 Then
Redim lngPaperNumbers(1 To lngPapers)
lngPapers = DeviceCapabilities(strDeviceName, strPort, DC_PAPERS, lngPaperNumbers(1), 0& _
)
strPaperList = String$(64 * lngPapers, 0)
lngPapers = DeviceCapabilities(strDeviceName, strPort, DC_PAPERNAMES, ByVal _
strPaperList, 0&)
For intPaperCount = 1 To lngPapers
strPaperName = Mid(strPaperList, 64 * (intPaperCount - 1) + 1, 64)
ComboBox4.AddItem Left$(strPaperName & vbNullChar, InStr(strPaperName, vbNullChar) - _
1)
Next
Else
MsgBox "Druckertreiber unterstützt das auslesen von Papierformaten nicht!", vbCritical, _
"Fehler"
End If
End Sub
Gruss
André