title image


Smiley Bericht: Hochformat, Seitenbreite, Kopien, Druckqualität, etc.
Bericht: Hochformat, Querformat, Seitenbreite, Seitenhöhe, Kopien, Druckqualität, etc.Hab mir selber ein Klassenmodul geschrieben das eine ganze Menge Druckeinstellungen eines Berichts auslesen und ändern lässt.Muss mit der LoadData-Funktion initialisiert werden, dann können alle Einstellungen gesetzt und/oder ausgelesen werden. Mehr Infos in der Hilfe unter PrtDevMode.Code ist nur schlecht auskommentiert, da ich ihn eigentlich nur für mich geschrieben habe******************* Code Anfang ************************Option Compare DatabaseOption ExplicitPrivate Type str_DEVMODE strGZF As String * 94End TypePrivate Type type_DEVMODE strDeviceName As String * 16 intSpecVersion As Integer intDriverVersion As Integer intSize As Integer intDriverExtra As Integer lngFields As Long intOrientation As Integer intPaperSize As Integer intPaperLength As Integer intPaperWidth As Integer intScale As Integer intCopies As Integer intDefaultSource As Integer intPrintQuality As Integer intColor As Integer intDuplex As Integer intResolution As Integer intTTOption As Integer intCollate As Integer strFormName As String * 16 lngPad As Long lngBits As Long lngPW As Long lngPH As Long lngDFI As Long lngDFr As LongEnd TypePrivate strName As StringPrivate PDeviceMode As type_DEVMODEPrivate DevModeExtra As StringPrivate boolCloseWhenDone As BooleanPrivate boolCalculatePaperSize As BooleanPublic Property Get DeviceName() As StringDeviceName = PDeviceMode.strDeviceNameEnd PropertyPublic Property Get SpecVersion() As IntegerSpecVersion = PDeviceMode.intSpecVersionEnd PropertyPublic Property Get DriverVersion() As IntegerDriverVersion = PDeviceMode.intDriverVersionEnd PropertyPublic Property Get Size() As IntegerSize = PDeviceMode.intSizeEnd PropertyPublic Property Get DriverExtra() As IntegerDriverExtra = PDeviceMode.intDriverExtraEnd PropertyPublic Property Get Fields() As LongFields = PDeviceMode.lngFieldsEnd PropertyPublic Property Let Orientation(Number As Integer)'1 Hochformat'2 QuerformatSelect Case NumberCase 1, 2 PDeviceMode.intOrientation = Number SaveDataEnd SelectEnd PropertyPublic Property Get Orientation() As IntegerOrientation = PDeviceMode.intOrientationEnd PropertyPublic Property Let PaperSize(Number As Integer)'1 US-Letter (8,5 x 11 Zoll)'2 US-Letter klein (8,5 x 11 Zoll)'3 US-Tabloid (11 x 17 Zoll)'4 US-Ledger (17 x 11 Zoll)'5 US-Legal (8,5 x 14 Zoll)'6 US-Statement (5,5 x 8,5 Zoll)'7 US-Exec. (7,25 x 10,5 Zoll)'8 A3 (297 x 420 mm)'9 A4 (210 x 297 mm)'10 A4 klein (210 x 297 mm)'11 A5 (148 x 210 mm)'12 B4 (250 x 354 mm)'13 B5 (182 x 257 mm)'14 Folio (8,5 x 13 Zoll)'15 Quarto (215 x 275 mm)'16 11 x 17 Zoll'18 Note (8,5 x 11 Zoll)'19 Briefumschlag #9 (3,875 x 8,875 Zoll)'20 Briefumschlag #10 (4,125 x 9,5 Zoll)'21 Briefumschlag #11 (4,5 x 10,375 Zoll)'22 Briefumschlag #12 (4,25 x 11 Zoll)'23 Briefumschlag #14 (5 x 11,5 Zoll)'24 Blatt in Größe C (17 x 22 Zoll)'25 Blatt in Größe D (22 x 34 Zoll)'26 Blatt in Größe E (34 x 44 Zoll)'27 Briefumschlag DL (110 x 220 mm)'28 Briefumschlag C5 (162 x 229 mm)'29 Briefumschlag C3 (324 x 458 mm)'30 Briefumschlag C4 (229 x 324 mm)'31 Briefumschlag C6 (114 x 162 mm)'32 Briefumschlag C65 (114 x 229 mm)'33 Briefumschlag B4 (250 x 353 mm)'34 Briefumschlag B5 (176 x 250 mm'35 Briefumschlag B6 (176 x 125 mm)'36 Briefumschlag (110 x 230 mm)'37 Briefumschlag Monarch (3,875 x 7,5 Zoll)'38 Briefumschlag 6-3/4 (3,625 x 6,5 Zoll)'39 US Std Endlospapier (14,875 x 11 Zoll)'40 Deutsch Std Endlospapier (8,5 x 12 Zoll)'41 Deutsch Legal Endlospapier (8,5 x 13 Zoll)'256 BenutzerdefiniertSelect Case NumberSelect Case NumberCase 1 To 16, 18 To 41 PDeviceMode.intPaperSize = Number SaveDataEnd SelectEnd PropertyPublic Property Get PaperSize() As IntegerPaperSize = PDeviceMode.intPaperSizeEnd PropertyPublic Property Let PaperLength(Number As Integer)'in 1/10 mmPDeviceMode.intPaperSize = 256PDeviceMode.intPaperLength = NumberSaveDataEnd PropertyPublic Property Get PaperLength() As Integer'in 1/10 mmIf (PDeviceMode.intPaperSize 256) And (PDeviceMode.intPaperSize 0) And boolCalculatePaperSize Then PaperLength = Sizedmm(True)Else PaperLength = PDeviceMode.intPaperLengthEnd IfEnd PropertyPublic Property Let PaperWidth(Number As Integer)'in 1/10 mmPDeviceMode.intPaperSize = 256PDeviceMode.intPaperWidth = NumberSaveDataEnd PropertyPublic Property Get PaperWidth() As Integer'in 1/10 mmIf (PDeviceMode.intPaperSize 256) And (PDeviceMode.intPaperSize 0) And boolCalculatePaperSize Then PaperWidth = Sizedmm(False)Else PaperWidth = PDeviceMode.intPaperWidthEnd IfEnd PropertyPublic Property Let PScale(Number As Integer)PDeviceMode.intScale = NumberSaveDataEnd PropertyPublic Property Get PScale() As IntegerPScale = PDeviceMode.intScaleEnd PropertyPublic Property Let Copies(Number As Integer)PDeviceMode.intCopies = NumberSaveDataEnd PropertyPublic Property Get Copies() As IntegerCopies = PDeviceMode.intCopiesEnd PropertyPublic Property Let DefaultSource(Number As Integer)'1 Oberer Schacht oder nur ein Schacht'2 Unterer Schacht'3 Mittlerer Schacht'4 Manueller Einzug'5 Schacht für Briefumschläge'6 Manueller Einzug für Briefumschläge'7 Automatischer Einzug'8 Traktoreinzug'9 Schacht für kleine Formate'10 Schacht für große Formate'11 Schacht mit großer Kapazität'14 Kassettenschacht'256 Ab hier gerätespezifische Schächte/EinzügeSelect Case NumberCase 1 To 11, 256 PDeviceMode.intDefaultSource = Number SaveDataEnd SelectEnd PropertyPublic Property Get DefaultSource() As IntegerDefaultSource = PDeviceMode.intDefaultSourceEnd PropertyPublic Property Let PrintQuality(Number As Integer)'-4 (hoch), -3 (mittel), -2 (niedrig) und -1 (Entwurf).Select Case NumberCase -4 To -1 PDeviceMode.intPrintQuality = Number SaveDataEnd SelectEnd PropertyPublic Property Get PrintQuality() As IntegerPrintQuality = PDeviceMode.intPrintQualityEnd PropertyPublic Property Let Color(Number As Integer)'1 (Farbe) und 2 (monochrom)Select Case ColorCase 1, 2 PDeviceMode.intColor = Number SaveDataEnd SelectEnd PropertyPublic Property Get Color() As IntegerColor = PDeviceMode.intColorEnd PropertyPublic Property Let Duplex(Number As Integer)'1 (einfach), 2 (horizontal) und 3 (vertikal)Select Case ColorCase 1 To 3 PDeviceMode.intDuplex = Number SaveDataEnd SelectEnd PropertyPublic Property Get Duplex() As IntegerDuplex = PDeviceMode.intDuplexEnd PropertyPublic Property Get Resolution() As IntegerResolution = PDeviceMode.intResolutionEnd PropertyPublic Property Get TTOption() As Integer'1 TrueType-Schriftarten werden als Grafik gedruckt. Dies ist die Standardeinstellung für Nadeldrucker.'2 TrueType-Schriftarten werden als ladbare Schriftarten (Schriftarten, die zur Aufbereitung in den Arbeitsspeicher des Druckers geladen werden) heruntergeladen. Dies ist die Standardeinstellung für Hewlett-Packard-Drucker, die mit PCL (Printer Control Language) arbeiten.'3 TrueType-Schriftarten werden durch Geräteschriftarten ersetzt. Dies ist die Standardeinstellung für PostScript-Drucker.TTOption = PDeviceMode.intTTOptionEnd PropertyPublic Property Get Collate() As IntegerCollate = PDeviceMode.intCollateEnd PropertyPublic Property Get FormName() As StringFormName = PDeviceMode.strFormNameEnd PropertyPublic Property Get Pad() As LongPad = PDeviceMode.lngPadEnd PropertyPublic Property Get Bits() As LongBits = PDeviceMode.lngBitsEnd PropertyPublic Property Get PW() As LongPW = PDeviceMode.lngPWEnd PropertyPublic Property Get PH() As LongPH = PDeviceMode.lngPHEnd PropertyPublic Property Get DFI() As LongDFI = PDeviceMode.lngDFIEnd PropertyPublic Property Get DFR() As LongDFR = PDeviceMode.lngDFrEnd PropertyPublic Property Let MarginLeft(Number As Double)Application.SetOption "Linker Rand", Number / 100End PropertyPublic Property Get MarginLeft() As DoubleMarginLeft = strToDouble(Application.GetOption("Linker Rand")) * 100End PropertyPublic Property Let MarginRight(Number As Double)Application.SetOption "Rechter Rand", Number / 100End PropertyPublic Property Get MarginRight() As DoubleMarginRight = strToDouble(Application.GetOption("Rechter Rand")) * 100End PropertyPublic Property Let MarginTop(Number As Double)Application.SetOption "Oberer Rand", Number / 100End PropertyPublic Property Get MarginTop() As DoubleMarginTop = strToDouble(Application.GetOption("Oberer Rand")) * 100End PropertyPublic Property Let MarginBottom(Number As Double)Application.SetOption "Unterer Rand", Number / 100End PropertyPublic Property Get MarginBottom() As DoubleMarginBottom = strToDouble(Application.GetOption("Unterer Rand")) * 100End PropertyPublic Property Let CloseWhenDone(Flag As Boolean)boolCloseWhenDone = FlagEnd PropertyPublic Property Get CloseWhenDone() As BooleanCloseWhenDone = boolCloseWhenDoneEnd PropertyPublic Property Let CalculatePaperSize(Flag As Boolean)boolCalculatePaperSize = FlagEnd PropertyPublic Property Get CalculatePaperSize() As BooleanCalculatePaperSize = boolCalculatePaperSizeEnd PropertyPublic Function LoadData(ByVal ReportName As String, ByVal CloseWhenDone As Boolean)If ReportName = strName Then Exit FunctionDim Rpt As ReportDim DevString As str_DEVMODEstrName = ReportNameboolCloseWhenDone = CloseWhenDoneDoCmd.OpenReport strName, acViewDesignIf boolCloseWhenDone Then Reports(strName).Visible = FalseSet Rpt = Reports(strName)DevModeExtra = Rpt.PrtDevModeDevString.strGZF = DevModeExtraLSet PDeviceMode = DevStringIf boolCloseWhenDone Then DoCmd.Close acReport, strName, acSaveNoSet Rpt = NothingEnd FunctionPrivate Sub SaveData()Dim Rpt As ReportDim DevString As str_DEVMODEDoCmd.OpenReport strName, acViewDesignIf boolCloseWhenDone Then Reports(strName).Visible = FalseSet Rpt = Reports(strName)LSet DevString = PDeviceModeMid$(DevModeExtra, 1, 68) = DevString.strGZFRpt.PrtDevMode = DevModeExtraDoCmd.Save acReport, Rpt.NameIf boolCloseWhenDone Then Reports(strName).Visible = True: DoCmd.Close acReport, strName, acSaveYesSet Rpt = NothingEnd SubPrivate Function Sizedmm(ByVal boolLength As Boolean) As Integer'alles in 1/10 mmConst lngZoll As Double = 160 / 63Const lngMM As Double = 10Dim inSizeNumber As IntegerIf (PDeviceMode.intOrientation = 1) Xor (boolLength) Then 'Länge und Querformat, oder Breite und Hochformat inSizeNumber = PDeviceMode.intPaperSizeElse 'Länge und Hochformat, oder Breite und Querformat inSizeNumber = PDeviceMode.intPaperSize + 1000End IfSelect Case inSizeNumberCase 38 Sizedmm = 3.625 * lngZollCase 19, 37 Sizedmm = 3.875 * lngZollCase 20 Sizedmm = 4.125 * lngZollCase 22 Sizedmm = 4.25 * lngZollCase 21 Sizedmm = 4.5 * lngZollCase 23 Sizedmm = 5 * lngZollCase 6 Sizedmm = 5.5 * lngZollCase 1038 Sizedmm = 6.5 * lngZollCase 7 Sizedmm = 7.25 * lngZollCase 1037 Sizedmm = 7.5 * lngZollCase 1, 2, 5, 14, 18, 40, 41, 1006 Sizedmm = 8.5 * lngZollCase 1019 Sizedmm = 8.875 * lngZollCase 1020 Sizedmm = 9.5 * lngZollCase 1021 Sizedmm = 10.375 * lngZollCase 1007 Sizedmm = 10.5 * lngZollCase 3, 4, 16, 39, 1001, 1002, 1018, 1022 Sizedmm = 11 * lngZollCase 1023 Sizedmm = 11.5 * lngZollCase 1040 Sizedmm = 12 * lngZollCase 1014, 1041 Sizedmm = 13 * lngZollCase 1005 Sizedmm = 14 * lngZollCase 1039 Sizedmm = 14.875 * lngZollCase 24, 1003, 1004, 1016 Sizedmm = 17 * lngZollCase 25, 1024 Sizedmm = 22 * lngZollCase 26, 1025 Sizedmm = 34 * lngZollCase 1026 Sizedmm = 44 * lngZollCase 27, 36 Sizedmm = 110 * lngMMCase 31, 32 Sizedmm = 114 * lngMMCase 35 Sizedmm = 125 * lngMMCase 11 Sizedmm = 148 * lngMMCase 28, 1031 Sizedmm = 162 * lngMMCase 34, 1035 Sizedmm = 176 * lngMMCase 13 Sizedmm = 182 * lngMMCase 9, 10, 1011 Sizedmm = 210 * lngMMCase 15 Sizedmm = 215 * lngMMCase 1027 Sizedmm = 220 * lngMMCase 30, 1028, 1032 Sizedmm = 229 * lngMMCase 1036 Sizedmm = 230 * lngMMCase 12, 33, 1034 Sizedmm = 250 * lngMMCase 1013 Sizedmm = 257 * lngMMCase 1015 Sizedmm = 275 * lngMMCase 8, 1009, 1010 Sizedmm = 297 * lngMMCase 29, 1030 Sizedmm = 324 * lngMMCase 1033 Sizedmm = 353 * lngMMCase 1012 Sizedmm = 354 * lngMMCase 1008 Sizedmm = 420 * lngMMCase 1029 Sizedmm = 458 * lngMMEnd SelectEnd FunctionPrivate Function strToDouble(ByVal strNumber As String) As DoubleDim intKomma As IntegerintKomma = InStr(strNumber, ",")If intKomma = 0 Then strToDouble = Val(strNumber)Else strToDouble = Val(Left(strNumber, intKomma - 1) & "." & Mid(strNumber, intKomma + 1))End IfEnd Function******************* Code Ende ************************

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: