Papierformat autom. durch VBA auswählen lassen?

Hallo Leute,
ich habe da mal eine Frage zur Papierformatauswahl via VBA. Ich wollte mit nachfolgendem VBA Code das richtige Papierformat automatisch setzen lassen.

With Workbooks("Rechnung.xls").Sheets("Briefumschlag")
.PageSetup.PaperSize = 148
.PrintPreview False
End With

Welche Zahl hinter dem Befehl .PageSetup.PaperSize einzusetzen ist, habe ich durch den Makrorekorder herausgefunden. Nun habe ich aber das Problem, dass auf einem anderen PC diese Nummer einem anderen Papierformat entspricht. Ich dachte mir, eventuell funktioniert es ja, wenn ich den Klartext, also den Text, der mir nach der Auswahl in dem Papierformatauswahlfeld angezeigt wird, anstelle der Zahl angebe. Ich habe also anstelle der Zahl 148 den Text "Brief A5 Excel(114x161mm)" angegeben, denn der wird mir nach der Auswahl angezeigt. Leider funktioniert das so nicht, es kommt zu einem Laufzeitfehler. Daher nun meine Frage, wie kann ich dieses benutzerdefinierte Format auf jedem Rechner, auf dem die Datei ausgeführt werden soll, automatisch auswählen lassen? Hat da jemand eine Idee oder funktioniert das nicht?
Ich hoffe, jemand kann mir da weiterhelfen?
Vorab besten Dank für die Hilfe,
Oliver S.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Ihr Kämpfer,
hab das mal für Euch angepasst. Sollte so eigentlich laufen, ich kanns aber nicht großartig testen, weil mir nur ein Rechner zur Verfügung steht. Problem ist, daß Oliver den Namen des Druckers (und den Anschluss?) kennen muss. Aber für die Auflistung aller verfügbaren Drucker gibts auch wieder schöne Lösungen, die kann ich Euch ja bei Bedarf wieder anpassen ;o)
Ansonsten: Reinhard, Du kannst wieder übernehmen.
So ruft Ihr die Papiernummer ab:

Sub Test()
MsgBox PaperCode("HP LaserJet IIIP", "LPT1", "Brief A5 Excel")
End Sub

und das hier kommt in ein allgemeines Modul. Keine Angst, Oliver, das musst Du nicht tiefer drin einsteigen. Ist aber Interessant, die Sache mal mit "F8" durchzugehen.

Option Explicit
'Original- Code von Elmar Boye
'httpe://groups.google.de/group/microsoft.public.de.vb/browse_thread/thread/24cd2731e6b1cc57/4aca54b7063ab986?lnk=st&q=DeviceCapabilities&rnum=28&hl=de#4aca54b7063ab986
' Geräteeigenschaften ermitteln (BOOL), verschiedene Declares für unterschiedliche Rückgaben
Private Declare Function DeviceCapabilities Lib "winspool.drv" Alias "DeviceCapabilitiesA" ( _
  ByVal strDeviceName As String, ByVal strPort As String, _
  ByVal lngIndex As Long, ByVal strOutput As String, _
  lngDevMode As Long) As Long
Private Declare Function DeviceCapabilitiesLong Lib "winspool.drv" Alias "DeviceCapabilitiesA" ( _
  ByVal strDeviceName As String, ByVal strPort As String, _
  ByVal lngIndex As Long, lngOutput As Long, _
  lngDevMode As Long) As Long
Private Declare Function DeviceCapabilitiesAny Lib "winspool.drv" Alias "DeviceCapabilitiesA" ( _
  ByVal strDeviceName As String, ByVal strPort As String, _
  ByVal lngIndex As Long, lngOutput As Any, _
  lngDevMode As Long) As Long
' Parameter für DeviceCapabilties.lngIndex
Const DC_FIELDS As Integer = 1
Const DC_PAPERS As Integer = 2
Const DC_PAPERSIZE As Integer = 3
Const DC_MINEXTENT As Integer = 4
Const DC_MAXEXTENT As Integer = 5
Const DC_BINS As Integer = 6
Const DC_DUPLEX As Integer = 7
Const DC_SIZE As Integer = 8
Const DC_EXTRA As Integer = 9
Const DC_VERSION As Integer = 10
Const DC_DRIVER As Integer = 11
Const DC_BINNAMES As Integer = 12
Const DC_ENUMRESOLUTIONS As Integer = 13
Const DC_FILEDEPENDENCIES As Integer = 14
Const DC_TRUETYPE As Integer = 15
Const DC_PAPERNAMES As Integer = 16
Const DC_ORIENTATION As Integer = 17
Const DC_COPIES As Integer = 18
' Pseudo Konstanten für Rückgaben
Const DC_BINNAME_LENGTH As Long = 24            ' Länge eines Schachtnamens
Const DC_PAPERNAME_LENGTH As Long = 64          ' Länge eines Papiernamens
Function PaperCode(strDevice As String, strPort As String, strPaperName As String) As Integer
'Code von Michav
Dim arrPaperNames() As String
Dim arrPapers() As Integer
Dim NumOfPapers As Integer
Dim x%
NumOfPapers = GetPrinterPapers(strDevice, strPort, arrPaperNames, arrPapers)
If NumOfPapers = -1 Then MsgBox "Drucker nicht gefunden": Exit Function
If NumOfPapers = -2 Then MsgBox "Informationen über Papiertypen nicht verfügbar": Exit Function  '?
For x = 0 To NumOfPapers - 1
    If UCase(arrPaperNames(x)) = UCase(strPaperName) Then
        PaperCode = arrPapers(x): Exit Function
    End If
Next x
MsgBox "Drucker hat dieses Papierformat nicht"
End Function
Function GetPrinterPapers(strDevice As String, strPort As String, arrPaperNames() As String, arrPapers() As Integer, Optional strPaperList As Variant) As Integer
'Original- Code von Elmar Boye
'angepasst von MichaV
' Liefert die verfügbaren Papierschächte eines Druckers
' Parameter:    PrinterNo    - Druckernummer aus Printers
'               arrPaperNames - Namen der Papierschächte
'               arrPapers     - Nummern der Papierschächte
'               strPaperList  - Liste für Comboboxen (ist optional) als Wertliste der Form: Name, Wert
' Rückgabe:     Anzahl der Papierformate, oder 0, wenn nicht zu ermitteln
   ' Dim strDevice As String, strPort As String
    Dim strPaperNames As String
    Dim lSize As Long, iIndex As Integer
    GetPrinterPapers = 0
    'If Not ValidPrinter(PrinterNo, True) Then Exit Function
    ' Liefert über eine interne Druckernummer Gerätenamen und Port zurück
    'strDevice = Printers(PrinterNo).PrinterDevice
    'strPort = Printers(PrinterNo).PrinterPort
    lSize = DeviceCapabilitiesLong(strDevice, strPort, DC_PAPERNAMES, ByVal 0&, ByVal 0&)
    If lSize <= 0 Then GetPrinterPapers = -1: Exit Function
    strPaperNames = String(lSize * DC_PAPERNAME_LENGTH + 2, 0)              ' lSize * 24 Characters
    lSize = DeviceCapabilitiesLong(strDevice, strPort, DC_PAPERS, ByVal 0&, ByVal 0&)
    If lSize <= 0 Then GetPrinterPapers = -2: Exit Function
    lSize = DeviceCapabilities(strDevice, strPort, DC_PAPERNAMES, strPaperNames, ByVal 0&)
    ReDim arrPaperNames(lSize - 1)
    For iIndex = 0 To lSize - 1
        'arrPaperNames(iIndex) = AsciiZToString(Mid$(strPaperNames, iIndex * DC_PAPERNAME_LENGTH + 1, DC_PAPERNAME_LENGTH))
        arrPaperNames(iIndex) = Replace(Mid$(strPaperNames, iIndex * DC_PAPERNAME_LENGTH + 1, DC_PAPERNAME_LENGTH), Chr(0), "")
    Next iIndex
    ReDim arrPapers(lSize - 1)                               ' lSize * WORD
    lSize = DeviceCapabilitiesAny(strDevice, strPort, DC_PAPERS, arrPapers(0), ByVal 0&)
    GetPrinterPapers = lSize
'    ' Für Wertliste Comboboxen
'    If Not IsMissing(strPaperList) Then
'        strPaperList = ""
'        For iIndex = 0 To lSize - 1
'            strPaperList = strPaperList & Lit(arrPaperNames(iIndex)) & ";" & arrPapers(iIndex) & ";"
'        Next iIndex
'    End If
End Function

Gruß- Micha
PS: Rückmeldung wäre nett.

Beliebteste Forumthreads (12 Monate)

Papierformat autom. durch VBA auswählen lassen?

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Papierformat autom. durch VBA auswählen lassen?

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread