Druckfenster modifizieren - Useform

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo André,
einbaue tu ich's dir nicht, nur zeigen wie's geht.

' **********************************************************************
' Modul: Modul14 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Sub Test14A()

    Dim objWMI As Object, objItem As Object
    Dim vntTempArray As Variant, vntPaperSize As Variant
    Dim lngPaperSizesArray() As Long, lngTemp As Long
    Dim intIndex As Integer, intCounter As Long

    'Alle möglichen Papierformate
    vntPaperSize = Array("Unbekannt", "Andere", "A", "B", "C", "D", "E", "Brief", "Legal", _
        "NA-10x13 Umschlag", "NA-9x12 Umschlag", "NA-Number-10 Umschlag", "NA-7x10 Umschlag", _
        "NA-9x11 Umschlag", "NA-10x14 Umschlag", "NA-Number-9 Umschlag", "NA-6x9 Umschlag", _
        "NA-10x15 Umschlag", "A0", "A1", "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9A10", _
        "B0", "B1", "B2", "B3", "B4", "B5", "B6", "B7", "B8", "B9", "B10", "C0", "C1", "C2C3", _
        "C4", "C5", "C6", "C7", "C8", "ISO-designiert", "JIS B0", "JIS B1", "JIS B2", "JIS B3", _
        "JIS B4", "JIS B5", "JIS B6", "JIS B7", "JIS B8", "JIS B9", "JIS B10", "Nicht zutreffend-Letter", _
        "Nicht zutreffend-Legal", "Umschlag B4", "Umschlag B5", "Umschlag C3", "Umschlag C4", "Umschlag C5", _
        "Umschlag C6", "Designierter langer Umschlag", "Umschlag Monarch", "Ausführen", "Folio", "Rechnung", _
        "Ledger", "Quartet")

    'Druckereigenschaften auslesen
    Set objWMI = GetObject("winmgmts:\\.\root\cimv2"). _
        ExecQuery("Select * from Win32_Printer where Name='Adobe PDF'")

    'Papierformate auslesen
    For Each objItem In objWMI
        vntTempArray = objItem.PaperSizesSupported
    Next

    'Papiersorten sortieren
    Call Quick_Sort(LBound(vntTempArray), UBound(vntTempArray), vntTempArray)

    'Papiersorten verdichten
    For intIndex = LBound(vntTempArray) To UBound(vntTempArray)
        If lngTemp <> vntTempArray(intIndex) Then
            intCounter = intCounter + 1
            Redim Preserve lngPaperSizesArray(1 To intCounter)
            lngPaperSizesArray(intCounter) = vntTempArray(intIndex)
            lngTemp = vntTempArray(intIndex)
        End If
    Next

    'Papiersorten ausgeben
    For intIndex = 1 To intCounter
        MsgBox vntPaperSize(lngPaperSizesArray(intIndex))
    Next

End Sub

Private Sub Quick_Sort(lngLBound As Long, lngUBound As Long, varArray As Variant)
    Dim lngIndex1 As Long, lngIndex2 As Long
    Dim varTemp As Variant, varBuffer As Variant
    lngIndex1 = lngLBound
    lngIndex2 = lngUBound
    varBuffer = varArray(Fix(lngLBound + lngUBound) / 2)
    Do
        Do While varArray(lngIndex1) < varBuffer
            lngIndex1 = lngIndex1 + 1
        Loop
        Do While varBuffer < varArray(lngIndex2)
            lngIndex2 = lngIndex2 - 1
        Loop
        If lngIndex1 <= lngIndex2 Then
            varTemp = varArray(lngIndex1)
            varArray(lngIndex1) = varArray(lngIndex2)
            varArray(lngIndex2) = varTemp
            lngIndex1 = lngIndex1 + 1
            lngIndex2 = lngIndex2 - 1
        End If
    Loop Until lngIndex1 > lngIndex2
    If lngLBound < lngIndex2 Then Call Quick_Sort(lngLBound, lngIndex2, varArray)
    If lngIndex1 < lngUBound Then Call Quick_Sort(lngIndex1, lngUBound, varArray)
End Sub

Gruß
Nepumuk

Public Sub Test14A() Dim objWMI As Object, objItem As Object Dim vntTempArray As Variant, vntPaperSize As Variant Dim lngPaperSizesArray() As Long, lngTemp As Long Dim intIndex As Integer, intCounter As Long 'Alle möglichen Papierformate vntPaperSize = Array("Unbekannt", "Andere", "A", "B", "C", "D", "E", "Brief", "Legal", _ "NA-10x13 Umschlag", "NA-9x12 Umschlag", "NA-Number-10 Umschlag", "NA-7x10 Umschlag", _ "NA-9x11 Umschlag", "NA-10x14 Umschlag", "NA-Number-9 Umschlag", "NA-6x9 Umschlag", _ "NA-10x15 Umschlag", "A0", "A1", "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9A10", _ "B0", "B1", "B2", "B3", "B4", "B5", "B6", "B7", "B8", "B9", "B10", "C0", "C1", "C2C3", _ _ "C4", "C5", "C6", "C7", "C8", "ISO-designiert", "JIS B0", "JIS B1", "JIS B2", "JIS B3", _ _ "JIS B4", "JIS B5", "JIS B6", "JIS B7", "JIS B8", "JIS B9", "JIS B10", "Nicht _ zutreffend-Letter", _ "Nicht zutreffend-Legal", "Umschlag B4", "Umschlag B5", "Umschlag C3", "Umschlag C4", " _ Umschlag C5", _ "Umschlag C6", "Designierter langer Umschlag", "Umschlag Monarch", "Ausführen", "Folio", _ "Rechnung", _ "Ledger", "Quartet") End Sub

Hallo André,
ich hab mich jetzt für die API - Variante entschieden. Die ist doch entschieden schneller als WMI.
Hier mal der etwas zurechtgestutzte Code deines Userforms. Zu mehr hab ich heute keine Lust.
Ich frag mich jetzt eigentlich nur, wie du dem ausgewählten Drucker beibringen willst, auf welches Papierformat er drucken soll. Ich weiß natürlich wie das geht, aber das sind gut 200 Zeilen Code unter Zuhilfenahme von mehreren API - Funktionen. Also Code, den du, wenn du dich täglich mehrere Stunden damit auseinandersetzt, in ein paar Jahren verstehen wirst.
Warum willst du überhaupt das Rad neu erfinden? Was gefällt dir nicht an dem Standarddialog bei dem alles automatisch funktioniert und nicht mit immensem Aufwand nachprogrammiert werden muss?
VBA bescheiden und so ein Vorhaben, ist wie nach bestandenem Dreiradführerschein in einen Ferrari zu steigen. Einfach ein paar Nummern zu groß.

' **********************************************************************
' 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... André ;-))", _
            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

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Druckfenster modifizieren - Useform

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Druckfenster modifizieren - Useform

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread