Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
DoCmd.OutputTo BUG SNP2TXT
zurück: Redundante Werte in einer Zeile zusammenfassen weiter: Split Zeichenfolge nach fixer Zeichenzahl Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Feedback Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
Zaska
VBA "Geht nicht, gibt es nicht!"


Verfasst am:
03. März 2009, 14:53
Rufname:

DoCmd.OutputTo BUG SNP2TXT - DoCmd.OutputTo BUG SNP2TXT

Nach oben
       Version: Office 2003

Hallo Zusammen,
ein Access Bericht besteht aus mehreren Unterberichten.
Der Command Docmd.outputTo konvertiert mir nicht sauber einen Access Report in *.txt um.
Nicht sauber heißt:
- Zeichen werden ausgelassen
- Ausgabestruktur Textformat entspricht nicht der Access Report Struktur

Der Accessbericht generiert einen C++ Code aus verschiedenen Softwaredatenbanken, Tabellen etc.
Wenn nach dem konvertieren in ein Textformat eine geschweifte Klammer oder sonst etwas fehlt, dann hat das fatale Folgen. Das Text File kann bis zu 1700 Zeilen betragen.

Bemerkenswert dabei ist, wenn man über einen pdf Druckertreiber aus einem Access Bericht ein PDF File erzeugt, sind die Daten sauber.
Ich habe mal über DAO einen Recordset von einem Access Report getan!
Code:
    Set ws = DBEngine.Workspaces(0)
    Set db = ws.Databases(0)
    Set rs = db.OpenRecordset(Reportname, dbOpenSnapshot, dbReadOnly)
Dabei kam folgendes beim Debug.Print heraus:
Zitat:
0x10;CAN;OUTPUT;40;CANcSS_LH_CMD;0;7;1;0;Wahr;
0x10;CAN;OUTPUT;41;CANcSS_RH_CMD;2;7;3;0;Wahr;
0x10;CAN;OUTPUT;38;CANcSS_LH_PS;4;1;4;1;Falsch;1
0x10;CAN;OUTPUT;39;CANcSS_RH_PS;4;0;4;0;Falsch;1
...
0x8D;CAN;OUTPUT;182;CANaStatusCC_S_3;0;7;3;0;Falsch;
0x8D;CAN;OUTPUT;183;CANaStatusMC_S_3;4;7;7;0;Falsch;
0x94;CAN;OUTPUT;184;CANaStatusCC_Fallback;0;7;3;0;Falsch;
0x94;CAN;OUTPUT;185;CANaStatusMC_Fallback;4;7;7;0;Falsch;
;;;;;;;;;;
Kann man dem RS etwas anfangen?!?
Welche Alternative gibt es zu dem Command Docmd.outputto,
also welche andere Möglichkeit besteht einen völlig korrekt abgebildeten Access Bericht in ein txt File zu konvertieren?

Danke.

Gruß Zas
Gast



Verfasst am:
03. März 2009, 15:58
Rufname:


AW: Docmd.outputto BUG SNP2TXT - AW: Docmd.outputto BUG SNP2TXT

Nach oben
       Version: Office 2003

Hatte gleiches Problem bei Generierung von RTF-Dateien, manche Zeichen kamen einfach nicht rüber. Etwas Abhilfe brachte Optimierung der Feldbreiten, denke aber, daß Du hierbei generell auf Konvertierung von Berichte verzichten solltest.
Der Bericht hat eine Datenherkunft, nimm die.
Ein Textdatei kannst Du auch so erstellen:
Code:
    Open var_pfad & var_datei For Output As #1
    Print #1, "Das ist eine Textdatei"
    Close #1
Zaska
VBA "Geht nicht, gibt es nicht!"


Verfasst am:
17. März 2009, 11:37
Rufname:

AW: DoCmd.OutputTo BUG SNP2TXT - AW: DoCmd.OutputTo BUG SNP2TXT

Nach oben
       Version: Office 2003

Zaska am 03. März 2009 um 15:16 hat folgendes geschrieben:
Hallo,
habe gerade einen tollen Hinweis erhalten.
Zitat:
"A simple method would be to programmatically print the Snapshot or the PDF(or even the original report) to a Text Only Printer driver. Every version of Windows contains a printer driver named "Generic / Text Only"."

Many thanks to Stephen Lebans
Ich habe es manuell getestet. Funktioniert fehlerfrei! Razz
Jetzt brauche ich nur noch das entsprechende VB Coding einen Drucker/Properties anzusprechen/einzustellen.
Das ist geilo hoch drei Twisted Evil
An Gast: --> THX
Lösung werde ich später posten.

Gruß ZAS

Zaska am 04. März 2009 um 09:41 hat folgendes geschrieben:
Mein kleiner Zwischenstand, kein Endstand, Coding ist noch redundant
Code:
Function Acces_Report_2_TXT_File(Reportname As String, Zielpfad_txt As String)
    Dim Prn As Printer
    Dim bo_ASCII As Boolean
   
    bo_ASCII = False
    For Each Prn In Printers
        If Prn.DeviceName = "ASCII" Then
             bo_ASCII = True
            Exit For
        End If
    Next Prn
    If bo_ASCII = False Then
    'Call Installiere_TXT_Printer Name: "ASCII" Standard / Drucker Treiber TX
        For Each Prn In Printers
            If Prn.DeviceName = "ASCII" Then
                bo_ASCII = True
                Exit For
            End If
        Next Prn
        If bo_ASCII = False Then
            MsgBox "Print_TXT_To_File-Error(TXT Printer drive is not " & _
                   "installed)"
            Exit Function
        End If
    End If
    If bo_ASCII = True Then
        For Each Prn In Printers
            If Prn.DeviceName = "ASCII" Then
                Set Printer = Prn
                Exit For
            End If
        Next Prn
        'Drucker Parameter einstellen
        With Printer
            .BottomMargin = 0
            .ColorMode = acPRCMMonochrome
            .ColumnSpacing = 0
            .Copies = 1
            .DataOnly = False
            .DefaultSize = False
            '.DeviceName = "ASCII"
            '.DriverName = "winspool"
            .Duplex = acPRDPSimplex
            '.ItemLayout = 0
            '.ItemsAcross = 0
            '.ItemSizeHeight = 0
            '.ItemSizeWidth = 0
            .LeftMargin = 0
            .Orientation = acPRORPortrait
            .PaperBin = acPRBNFormSource
            .PaperSize = acPRPSA4
            .PrintQuality = acPRPQHigh
            .RightMargin = 0
            .RowSpacing = 0
            .TopMargin = 0
        End With
        'Print  # Anweisung oder/und Print Methode
    End If
End Function

Hallo,
der Zwischenstand SNP2TXT
Code:
Option Compare Database

Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" _
    (ByVal DirPath As String) As Long
   
Function getPrinterName(sPartOfName As String) As String
    Dim objNet As Object
    Dim objPrinter As Object
    Dim ix As Integer
   
    Set objNet = CreateObject("WScript.Network")
    Set objPrinter = objNet.EnumPrinterConnections
    For ix = 0 To objPrinter.Count - 1 Step 2
        If InStr(UCase(objPrinter.Item(ix + 1)), UCase(sPartOfName)) > 0 Then
            getPrinterName = objPrinter.Item(ix + 1)
            Exit Function
        End If
    Next ix
End Function

Function Test_Report_to_txt()
    Dim i, k As Integer

    k = 0
    For i = 0 To CurrentProject.AllReports.Count - 1
        'If InStr(CurrentProject.AllReports(i).Name, "R_all") > 0 Then
            If k = 0 Then
                On Error Resume Next
                Kill CurrentProject.Path & "\temp\TXT\*.*"
                Kill "C:\temp\*.*"
                On Error GoTo 0
                k = k + 1
            End If
            Transform_Report_to_txt CurrentProject.AllReports(i).Name
        'End If
    Next i
    'Transform_Report_to_txt "R_IoMapMatrix"
End Function

'Verweis Scripting Runtime
Function Transform_Report_to_txt(Reportname As String)
    Dim fso As Object
    Dim Prn As Printer
    Dim bo_ASCII As Boolean
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    bo_ASCII = False
    For Each Prn In Printers
        If Prn.DeviceName = "ASCII" Then
            bo_ASCII = True
            Exit For
        End If
    Next Prn
    If bo_ASCII = False Then
        MsgBox "Call Install_Printer, call Install_SetPort " & _
               "c:/temp/Report.txt" & Chr(10) & "' Printer " & _
               "Generic / Text Only muß installiert sein." & Chr(10) & _
               "Name des Druckers muß -> ASCII <sein> Seleczt a local " & _
               "Port as the Type, and click on New port." & Chr(10) & _
               "For the Port name, enter a fully qualified file name, " & _
               "e.g. c:\temp\Report.txt"
        For Each Prn In Printers
            If Prn.DeviceName = "ASCII" Then
                bo_ASCII = True
                Exit For
            End If
        Next Prn
        If bo_ASCII = False Then
            MsgBox "Print_TXT_To_File-Error(TXT Printer drive is not " & _
                   "installed)"
            Exit Function
        End If
    End If
    If bo_ASCII = True Then
        For Each Prn In Printers
            If Prn.DeviceName = "ASCII" Then
                Set Printer = Prn
                Exit For
            End If
        Next Prn
        'Drucker Parameter einstellen
        With Printer
            .BottomMargin = 0
            .ColorMode = acPRCMMonochrome
            .ColumnSpacing = 0
            .Copies = 1
            .DataOnly = False
            .DefaultSize = False
            .Duplex = acPRDPSimplex
            .LeftMargin = 0
            .Orientation = acPRORPortrait
            .PaperBin = acPRBNFormSource
            .PaperSize = acPRPSA4
            .PrintQuality = acPRPQHigh
            .RightMargin = 0
            .RowSpacing = 0
            .TopMargin = 0
        End With
        'Temporäres Verzeichnis  Druckerport wird geschrieben
        'Das erfordert eine einmalige manuelle Einstellung unter Drucker
        'Eigenschaften:
        'Under the ports tab in printer properties, click on add port
        'Seleczt a local Port as the Type, and click on New port.
        'For the Port name, enter a fully qualified file name,
        'e.g. c:\temp\Report.txt
        MakeSureDirectoryPathExists "C:\temp\"
        On Error Resume Next
        Kill "C:\temp\*.*"
        On Error GoTo 0
        MakeSureDirectoryPathExists CurrentProject.Path & "\temp\TXT\"
        'Report Oeffnen; Drucker erzeugt TXT-File im Verzeichnis
        'CurrentProject.path & "\temp\TXT\ als Report.txt
        On Error Resume Next
        DoCmd.OpenReport Reportname, acViewNormal
        If Err.Number <> 0 Then
            On Error GoTo 0
            Debug.Print Reportname & "  Error:" & " " & Err.Number
            Exit Function
        End If
        ' Spool wird erzeugt
        ' Spooler erzeugt Txt.File
        ' Txt File kann aber erst kopiert werden, wenn es existiert
        ' D.h. VB Code Ablauf ist schneller als die Textdatei erzeugt werden
        ' kann, von daher Pause-Kriterium im Do-Loop ist die Er.Nummer
        Do
            On Error Resume Next
            'Temporaere Report.txt wird kopiert zu Reportname_echt.txt im
            'Verzeicnis CurrentProject.path & "\temp\TXT\
            FileCopy "C:\temp\Report.txt", CurrentProject.Path & _
                                           "\temp\TXT\" & Reportname & ".txt"
            'MsgBox Err.Number
            If Err.Number = 0 Then
                On Error GoTo 0
                Exit Do
            End If
        Loop
Debug.Print Reportname & "   " & FileSize("C:\temp\Report.txt") & "   "; _
            FileSize(CurrentProject.Path & "\temp\TXT\" & Reportname & ".txt")
        'Das temporaere Txt wird geloescht
        On Error Resume Next
        Kill "C:\temp\*.*"
        On Error GoTo 0
    End If
    Set Printer = Nothing
End Function

'Automatisches Installieren eines Druckers, der im Lieferumfang von Windows
'enthalten ist:
Function Install_Printer()
    'MsgBox Chr$(34)
    Shell "rundll32 printui.dll,PrintUIEntry /if /f " & _
          "c:\Windows\inf\ntprint.inf /r " & _
          Chr$(34) & "C:\temp\Report.txt" & Chr$(34) & " /m " & _
          Chr$(34) & "Generic / Text Only" & Chr$(34) & " /b " & _
          Chr$(34) & "ASCITest" & Chr$(34) & " /z"
End Function

'Ebenso lässt er sich auch wieder entfernen:
Function De_Install_Printer()
    Shell "rundll32 printui.dll,PrintUIEntry /dl /n " & _
          Chr$(34) & "Mein Drucker" & Chr$(34)
    'Es muss nur im Aufruf der Pfad zu der inf Datei (Windows Verzeichnis)
    'angepasst werden.
End Function

'Eine Beschreibung der einzelnen Parameter finden Sie unter:
 'http://www.lrz-muenchen.de/~fakler/windowsnt/faq/printui_syntax.html
Rem Drucker über Scripte verwalten/bearbeiten mit PRINTUI.DLL
Rem---------------------------------------------------------------------------
Rem Syntax: rundll32 printui.dll,PrintUIEntry [Optionen]
Rem /a  [Datei] Name der Binärdatei
Rem /b [Name] Basisdruckername
Rem /c [Name] UNC-Computername, wenn der Vorgang auf einem Remotecomputer
Rem           ausgeführt wird.
Rem /dl Löscht den lokalen Drucker.
Rem /dn Löscht die Netzwerkdruckerverbindung.
Rem /dd Löscht den Druckertreiber.
Rem /e Zeigt Druckeinstellungen an
Rem /f [Datei] Entweder INF-Datei oder Ausgabedatei.
Rem /ga Fügt Druckerverbindungen pro Maschine hinzu.
Rem /ge Listet Druckerverbindungen pro Maschine auf.
Rem /gd Löscht Druckerverbindungen pro Maschine.
Rem /h [Arch] Treiberarchitektur Alpha | Intel | Mips | PowerPC.
Rem /ia Installiert Druckertreiber mithilfe einer INF-Datei.
Rem /id Installiert Druckertreiber mithilfe des Assistenten.
Rem /if Installiert Drucker mithilfe der angegebenen INF-Datei.
Rem /ii Installiert Drucker mithilfe des Assistenten und einer INF-Datei.
Rem /il Installiert Drucker mithilfe des Assistenten.
Rem /in Fügt eine Netzwerkdruckerverbindung hinzu.
Rem /j [Anbieter] Druckanbietername
Rem /k Druckt eine Testseite auf dem angegebenen Drucker aus. Kann bei der
Rem    Druckerinstallation nicht verwendet werden.
Rem /l [Pfad] Quellpfad des Druckertreibers
Rem /m [Modell] Modellname des Druckertreibers
Rem /n [Name] Druckername
Rem /o Zeigt die Druckerwarteschlange an.
Rem /p Zeigt Druckereigenschaften an.
Rem /q Stiller Modus. Fehlermeldungen werden nicht angezeigt.
Rem /r [Anschluss] Anschlussname
Rem /s Zeigt Servereigenschaften an.
Rem /Ss Speichert Druckereinstellungen in einer Datei.
Rem /Sr Stellt Druckereinstellungen aus einer Datei wieder her.
Rem Speichert Optionsattribute für Druckereinstellungen oder stellt diese
Rem wieder her.
Rem Die Attribute müssen am Ende des Befehls stehen: 2 PRINTER_INFO_2
Rem 7 PRINTER_INFO_7
Rem c Farbprofil
Rem d Druckerdaten
Rem s Sicherheitsbeschreibung
Rem g Globaler DevMode
Rem m Minimale Einstellungen
Rem u Benutzer - DevMode
Rem r Namenskonflikte lösen
Rem f Namen erzwingen
Rem p Anschluss zuordnen
Rem /u Verwendet den vorhandenen Druckertreiber, sofern bereits einer
Rem    installiert ist.
Rem /t [#] Nullbasierte Indexseite zum Starten
Rem /v [Version] Eine der folgenden Treiberversionen: Windows 95 oder 98 |
Rem              Windows NT 3.1 | Windows NT 3.5 oder 3.51 | Windows NT 3.51 |
Rem              Windows NT 4.0 | Windows NT 4.0 oder 2000 | Windows 2000
Rem /w Fordert einen Treiber an, wenn der angegebene Treiber nicht in der
Rem    INF-Datei gefunden wird.
Rem /y Richtet den Drucker als Standarddrucker ein.
Rem /Xg Liest Druckereinstellungen.
Rem /Xs Richtet Druckereinstellungen ein.
Rem /z Gibt diesen Drucker nicht automatisch frei.
Rem /Z Gibt diesen Drucker frei. Verwendung nur mit der Option /if möglich.
Rem /? Zeigt diese Hilfemeldung an.
Rem @ [Datei] Datei mit Befehlszeilenargumenten
Rem Beispiele:
Rem Startet die Servereigenschaften:
Rem rundll32 printui.dll,PrintUIEntry /s /t1 /n\\Computer
Rem Startet die Druckereigenschaften:
Rem rundll32 printui.dll,PrintUIEntry /p /n\\Computer\Drucker
Rem Startet den Druckerinstallations-Assistenten lokal:
Rem rundll32 printui.dll, PrintUIEntry / il
Rem Startet den Druckerinstallations-Assistenten auf \\Computer:
Rem rundll32 printui.dll,PrintUIEntry /il /c\\Computer
Rem Startet die Warteschlangenansicht:
Rem rundll32 printui.dll,PrintUIEntry /o /n\\Computer\Drucker
Rem Startet eine INF-Installation:
Rem rundll32 printui.dll,PrintUIEntry /if /b "Testdrucker" /f %windir%\inf\ntprint.inf /r "lpt1:" /m "AGFA-AccuSet v52.3"
Rem Startet den Druckerinstallations-Assistenten mithilfe einer INF-Datei:
Rem rundll32 printui.dll,PrintUIEntry /ii /f %windir%\inf\ntprint.inf
Rem Fügt eine Druckerverbindung pro Computer hinzu:
Rem rundll32 printui.dll,PrintUIEntry /ga /c\\Computer /n\\Computer\Drucker /j"LanMan-Druckdienste"
Rem Löscht die Druckerverbindung pro Maschine:
Rem rundll32 printui.dll,PrintUIEntry /gd /c\\Computer /n\\Computer\Drucker
Rem Zählt die Druckerverbindungen pro Maschine auf:
Rem rundll32 printui.dll,PrintUIEntry /ge /c\\Computer
Rem Fügt einen Druckertreiber mithilfe einer INF-Datei hinzu:
Rem rundll32 printui.dll,PrintUIEntry /ia /c\\Computer /m "AGFA-AccuSet v52.3" /h "Intel" /v "Windows 2000" /f %windir%\inf\ntprint.inf
Rem Entfernt Druckertreiber:
Rem rundll32 printui.dll,PrintUIEntry /dd /c\\Computer /m "AGFA-AccuSet v52.3" /h "Intel" /v "Windows 2000"
Rem Richtet den Drucker als Standarddrucker ein:
Rem rundll32 printui.dll,PrintUIEntry /y /n "Drucker"
Rem Richtet einen Kommentar zum Drucker ein:
Rem rundll32 printui.dll,PrintUIEntry /Xs /n "Drucker" Comment "Mein cooler Drucker"
Rem Liest die Druckereinstellungen:
Rem rundll32 printui.dll,PrintUIEntry /Xg /n "Drucker"
Rem Schreibt die Druckereinstellungsergebnisse in eine Datei:
Rem rundll32 printui.dll,PrintUIEntry /f "results.txt" /Xg /n "Drucker"
Rem Befehlssyntax für das Einrichten der Druckereinstellungen:
Rem rundll32 printui.dll,PrintUIEntry /Xs /n "Drucker" ?
Rem Speichert alle Druckereinstellungen in einer Datei:
Rem rundll32 printui.dll,PrintUIEntry /Ss /n "Drucker" /a "datei.dat"
Rem Stellt alle Druckereinstellungen aus einer Datei wieder her:
Rem rundll32 printui.dll,PrintUI /Sr /n "Drucker" /a "datei.dat"
Rem Speichert Level-2-Druckerinformationen in einer Datei:
Rem rundll32 printui.dll,PrintUIEntry /Ss /n "Drucker" /a "datei.dat" 2
Rem Stellt aus einer Datei die Druckersicherheitsbeschreibung wieder her:
Rem rundll32 printui.dll,PrintUIEntry /Sr /n "Drucker" /a "datei.dat" s
Rem Stellt aus einer Datei die globalen Devmode- und Druckerdaten wieder her:
Rem rundll32 printui.dll,PrintUIEntry /Sr /n "Drucker" /a "datei.dat" g d
Rem Stellt aus einer Datei die minimalen Einstellungen wieder her und löst den Anschlussnamen auf:
Rem rundll32 printui.dll,PrintUIEntry /Sr /n "Drucker" /a "datei.dat" m p
'#############################################################################
Public Function FileSize(ByVal sFile As String) As Long
    ' Der Parameter sFile enthält den zu prüfenden Dateinamen
    Dim Size As Long
   
    On Local Error Resume Next
    Size = FileLen(sFile)
    FileSize = IIf(Err = 0, Size, -1)
    On Local Error GoTo 0
End Function
Kommentar
Bugs:
Nicht alle Eigenschaften des Druckertreibers lassen sich über VBA installieren.
Die Txt Feldbreite ist abhängig von der eingerichteten Schriftgröße und Papiergröße des Formulars.
Der Access Bericht Snapshot erzeugt automatisch einen Zeilenumsprung in Anhängigkeit der Schriftgröße und Snapshotformatbreite.
Diese Information geht dem Druckertreiber verloren. Der Drucktreiber interpretiert den Zeilenumbruch nicht, sondern interpretiert eine neue Druckzeile.

Bisheriges Resultat--> Confused einfach nicht brauchbar.

Neuer Lösungsansatz wäre den SQL (Rowsource) des Access Objektes Report auszulesen. Den SQL ausführen, das Ergebnis in ein Recordset zu übertragen.
Den recordset mittels printline txt generieren.

Wäre ja eine tolle Sache.
Im amerikanischen Forum funktioniert es angeblich, nur bei mir nicht, weil die Access Bibliothek den Comand Rowsource nur für die Objekte Form, Listfields usw zulässt, aber nicht für den Report.
Code:
    Dim strSQL As String
    Dim rsData As New ADODB.Recordset
   
    strSQL = Reports("Name of Report").RowSource
    rsData.Open strSQL, CurrentProject.Connection, adOpenKeyset
    'now you can access the records
    Do While rsData.EOF = False
        Debug.Print rsData.Fields(1).Name
        rsData.MoveNext
    Loop

Servus, zas
Nachtrag: Zaska am 18. März 2009 um 09:27 hat folgendes geschrieben:
Teillösung:
Der Access-Bericht wird vor dem Textprinter Comand auf das Format "Querformat" und "11x17 Zoll" umformatiert und nach den Textprinter Comand wieder auf das ursprüngliche Format formatiert.

Textprinterformat und Berichtformat sind identisch.

Änderungen
Function Acces_Report_2_TXT_File(Reportname As String, Zielpfad_txt As String)
Code:
    With Printer
        .BottomMargin = 0
        .ColorMode = acPRCMMonochrome
        .ColumnSpacing = 0
        .Copies = 1
        .DataOnly = False
        .DefaultSize = False
        .Duplex = acPRDPSimplex
        .LeftMargin = 0
        .Orientation = acPRORPortrait
        .PaperBin = acPRBNFormSource
        .PaperSize = acPRPS11x17 '<== HIER ###################################
        .ItemLayout = acPRVerticalColumnLayout '<== HIER #####################
        .PrintQuality = acPRPQHigh
        .RightMargin = 0
        .RowSpacing = 0
        .TopMargin = 0
    End With
Code:
'Report Seite einrichten Querformat und max. Breite
    Call fTM_RepPapierGröße(ReportName, 17) ' 11x17 Zoll '<== HIER ###########
    Call fTM_RepOrientierung(ReportName, 2) ' Querformat '<== HIER ###########
    'Report Oeffnen; Drucker erzeugt TXT-File im Verzeichnis
    'CurrentProject.path & "\temp\TXT\ als Report.txt
    On Error Resume Next
    DoCmd.OpenReport ReportName, acViewNormal
    If Err.Number <> 0 Then
        On Error GoTo 0
        Debug.Print ReportName & "  Error:" & " " & Err.Number
        Exit Function
    End If
' Report wieder auf seine Ursprüngsgröße konvertieren
    Call fTM_RepPapierGröße(ReportName, 9)  'A4          '<== HIER ###########
    Call fTM_RepOrientierung(ReportName, 1) 'Hochformat  '<== HIER ###########
Klassenmodul für "Seite einrichten Bericht" gibt es als open source
unter Downloads auf www.team-moeller.de

Zur Zeit tüftle ich, wie man einen Lokalen Druckeranschluss "C:\blala" via VBA über die PRINTUI.DLL einrichten kann.

Gruß Zas
Zaska
VBA "Geht nicht, gibt es nicht!"


Verfasst am:
20. März 2009, 13:05
Rufname:


AW: DoCmd.OutputTo BUG SNP2TXT - AW: DoCmd.OutputTo BUG SNP2TXT

Nach oben
       Version: Office 2003

Der Code ist nochmals verfeinert worden, so daß 255 Zeichen pro Zeile ausgegeben werden können.
Der Trick besteht darin, den Access Bericht vor dem Textprinten den Schriftgrad auf "1" zu setzten und später wieder auf den ursprünglichen Schriftgrad "8".
Wenn unterschiedliche Schriftgrade verwendet werden, könnte man die original Parameter "Schriftgradgrößen" z8ur Zwischenspeicherung in ein Array einlesen, um nach dem Textprinten den Access Bericht wieder auf den Originalschriftgrad konvertieren zu können.

Schriftgrad eines Access Berichtes ändern:
Ganz witzig ist, daß in offiziellen VBA Bekanntmachungen der Schriftgrad für einen Access Bericht sich über VBA nicht direkt ändern liese. Ein Event wäre die Vorraussetzung dafür. Es gibt unzählige Beispiele zu Druck-Events den Schriftgrad zu ändern. --> Für mein Vorhaben war dies nicht brauchbar.
Es bat sich das Event "Entwurfansicht" an. Das Objekt Acces Bericht ist in der Entwurfanscht ansprechbar. Jeder Bericht besteht aus mehren Labels und Bezeichungsfelder. Dies sind alles sogenannte "Steuerelemente" also "Controls", deren Eigenschaften man via VBA ändern kann, somit auch den Schriftgrad.
Code:
Function Report_Schriftgrad_Formatieren(Reportname As String, Size As Integer)
    Dim rep As Report
'Bildschirmaktualisierung ausschalten
    DoCmd.Echo False
    'Warnungen abschalten
    DoCmd.SetWarnings False
    'Bericht in der Etwurfsansicht öffnen
    DoCmd.OpenReport Reportname, acViewDesign
    'Bezug auf aktuell geöffneten Bericht nehmen
    Set rep = Reports(0)
    'irgendwas mit Controls machen
    For Each ctl In rep.Controls
        If ctl.ControlType = acTextBox Then
            ctl.FontSize = Size
        End If
    Next ctl
    'Bericht schließen, Änderungen werden gespeichert
    DoCmd.Close acReport, Reportname
    DoCmd.SetWarnings True
    DoCmd.Echo True
    Set rep = Nothing
End Function
So schliesst der neue Stand zu:
Code:
Option Compare Database

Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" _
    (ByVal DirPath As String) As Long
   
Function Test_Report_to_txt()
    Dim i As Integer, k As Integer
   
    k = 0
    For i = 0 To CurrentProject.AllReports.Count - 1
        'If InStr(CurrentProject.AllReports(i).Name, "R_all") > 0 Then
            If k = 0 Then
                On Error Resume Next
                Kill CurrentProject.Path & "\temp\TXT\*.*"
                Kill "C:\temp\*.*"
                On Error GoTo 0
                k = k + 1
            End If
            'Debug.Print CurrentProject.AllReports(i).Name
            Transform_Report_to_txt CurrentProject.AllReports(i).Name
        'End If
    Next i
    'Transform_Report_to_txt "R_IoMapMatrix"
End Function

'Verweis Scripting Runtime
Function Transform_Report_to_txt(Reportname As String)
    Dim strPrinterOld As String
    Dim Prn As Printer
    Dim bo_ASCII As Boolean
   
    bo_ASCII = False
    'Bildschirmaktualisierung ausschalten
    DoCmd.Echo False
    'Warnungen abschalten
    DoCmd.SetWarnings False
    For Each Prn In Printers
        If Prn.DeviceName = "ASCII" Then
             bo_ASCII = True
            Exit For
        End If
    Next Prn
    If bo_ASCII = False Then
        'Windows Textdrucker "Generic / Text Only"
        'und Lokaler Druckerport "c:\temp\Report.txt" werden installiert,
        'falls nicht vorhanden
        Call MakeSureDirectoryPathExists("c:\temp\")
        Call Create_Port("c:\temp\Report.txt")
        Call Install_Printer
        For Each Prn In Printers
            If Prn.DeviceName = "ASCII" Then
                bo_ASCII = True
                Exit For
            End If
        Next Prn
        If bo_ASCII = False Then
            'Nach dem Installieren des Textdruckers, muss die Funktion
            '"Transform_Report_to_txt" erneut aufgerufen werden, damit die
            'neuen Druckerparameter bekannt werden.
            Call Transform_Report_to_txt(Reportname)
            Exit Function
        End If
    End If
    If bo_ASCII = True Then
        For Each Prn In Printers
            If Prn.DeviceName = "ASCII" Then
                Set Printer = Prn
                Exit For
            End If
        Next Prn
        'Ursprünglichen Standarddrucker einer Variable übergeben
        strPrinterOld = Application.Printer.DeviceName
        'Der Drucker "ASCII" wird als Drucker für Access festgelegt
        Application.Printer = Application.Printers("ASCII")
        '"ASCII" Drucker Parameter werden eingestellt
        With Printer
            .BottomMargin = 0
            .ColorMode = acPRCMMonochrome
            .ColumnSpacing = 0
            .Copies = 1
            .DataOnly = False
            .DefaultSize = False
            .Duplex = acPRDPSimplex
            .Orientation = acPRORPortrait
            .PaperBin = acPRBNFormSource
            .PaperSize = acPRPS11x17
            .ItemLayout = acPRVerticalColumnLayout
            .PrintQuality = acPRPQHigh
            .LeftMargin = 0
            .RightMargin = 0
            .RowSpacing = 0
            .TopMargin = 0
        End With
        MakeSureDirectoryPathExists "C:\temp\"
        On Error Resume Next
        Kill "C:\temp\*.*"
        On Error GoTo 0
        MakeSureDirectoryPathExists "C:\temp\Report.txt"
        'Bericht Schriftgroesse verkleinern
        Call Report_Schriftgrad_Formatieren(Reportname, 1)
        'Bericht Seite einrichten Querformat und max. Breite
        Call fTM_RepPapierGröße(Reportname, 17) ' 11x17 Zoll
        Call fTM_RepOrientierung(Reportname, 2) ' Querformat
        'Bericht Oeffnen; Drucker erzeugt TXT-File im Verzeichnis
        'CurrentProject.path & "\temp\TXT\ als Report.txt
        On Error Resume Next
        'Drucken
        DoCmd.OpenReport Reportname, acViewNormal
        If Err.Number <> 0 Then
            On Error GoTo 0
            'Debug.Print Reportname & "  Error:" & " " & Err.Number
            Exit Function
        End If
        ' Txt File kann aber erst kopiert werden, wenn es existiert
        ' D.h. VB Code Ablauf ist schneller als die Textdatei erzeugt werden kann,
        ' von daher Pause-Kriterium im Do-Loop ist die Er.Nummer
        Do
            On Error Resume Next
            'Temporaere Report.txt wird kopiert zu Reportname_echt.txt im
            'Verzeicnis CurrentProject.path & "\temp\TXT\
            FileCopy "C:\temp\Report.txt", _
                     CurrentProject.Path & "\temp\TXT\" & Reportname & ".txt"
            'MsgBox Err.Number
            If Err.Number = 0 Then
                On Error GoTo 0
                Exit Do
            End If
        Loop
        'Bericht wieder auf seine Ursprüngsgröße konvertieren
        Call fTM_RepPapierGröße(Reportname, 9)  'A4
        Call fTM_RepOrientierung(Reportname, 1) 'Hochformat
        'Bericht Schriftgrad aud Ursprung 8 konvertieren
        Call Report_Schriftgrad_Formatieren(Reportname, 8)
        'Ursprünglicher Standarddrucker wird zugewiesen
        Application.Printer = Application.Printers(strPrinterOld)
        'Prüft, vergleicht Ursprungsdatei- mit Zieldateigröße, d.h. ob keine
        'Daten verloren gegangen ist.
        'Debug.Print Reportname & "   " & FileSize("C:\temp\Report.txt") & _
                      "   "; FileSize(CurrentProject.path & "\temp\TXT\" & _
                                      Reportname & ".txt")
        'Temporaere verzeichnis wird geloescht
        On Error Resume Next
        Kill "C:\temp\*.*"
        On Error GoTo 0
    End If
    Set Printer = Nothing
    'Warnings und Echo einschalten
    DoCmd.SetWarnings True
    DoCmd.Echo True
End Function

'Automatisches Installieren des Textdruckers "Generic / Text Only"
'Druckername "ASCII", der im Lieferumfang von Windows enthalten ist.
Function Install_Printer()
    Shell "rundll32 printui.dll,PrintUIEntry /if /f " & _
          "c:\Windows\inf\ntprint.inf /r " & _
          Chr$(34) & "C:\temp\Report.txt" & Chr$(34) & " /m " & _
          Chr$(34) & "Generic / Text Only" & Chr$(34) & " /b " & _
          Chr$(34) & "ASCII" & Chr$(34) & " /z"
End Function

'Automatisches Entfernen des Textdruckers "Generic / Text Only" Druckername "ASCII"
Function De_Install_Printer()
    On Error Resume Next
    Shell "rundll32 printui.dll,PrintUIEntry /dl /n " & _
    Chr$(34) & "ASCII" & Chr$(34)
    On Error GoTo 0
End Function

Function Port_test()
    Call MakeSureDirectoryPathExists("C:\temp\temp\")
    Call Create_Port("C:\temp\temp\Test.xls")
End Function
   
'prnadmin.dll muß installiert sein
'--> Kostenloser Download  Microsoft Homepage
'    "Windows Server 2003 Resource Kit Tool"
'Installiert den lokalen Druckeranschluss "C:\temp\Report.txt"
Function Create_Port(localportname As String)
    Dim oPort
    Dim oMaster
   
    On Error Resume Next
    Set oPort = CreateObject("Port.Port.1")
    Set oMaster = CreateObject("PrintMaster.PrintMaster.1")
    If Err.Number = 429 Then ' prnadmin.dll ist noch nicht registriert
        If Not Registered Then
            ' prnadmin.dll wird über regserv.exe regisriert
            Call Shell("regsvr32 /S prnadmin.dll", vbHide)
            Registered = True
            'rekursiv die Funktion Create_Port + Parameterangabe aufrufen
            Call Create_Port("c:\temp\Report.txt")
        End If
        Exit Function
    End If
    oPort.PortType = 3 'The type of the port can be 1 (TCP RAW), 2 (TCP LPR),
                       'or 3 (standard local).
    oPort.portname = localportname 'The name of the port cannot be omitted.
    oMaster.PortAdd oPort
    If Err.Number <> 0 Then
        'MsgBox "Lokaler Druckerport C:\temp\Report.txt existiert bereits"
    End If
    On Error GoTo 0
End Function

Function Report_Schriftgrad_Formatieren(Reportname As String, Size As Integer)
    Dim rep As Report
   
    'Bildschirmaktualisierung ausschalten
    DoCmd.Echo False
    'Warnungen abschalten
    DoCmd.SetWarnings False
    'Bericht in der Etwurfsansicht öffnen
    DoCmd.OpenReport Reportname, acViewDesign
    'Bezug auf aktuell geöffneten Bericht nehmen
    Set rep = Reports(0)
    'irgendwas mit Controls machen
    For Each ctl In rep.Controls
        If ctl.ControlType = acTextBox Then
            ctl.FontSize = Size
        End If
    Next ctl
    'Bericht schließen, Änderungen werden gespeichert
    DoCmd.Close acReport, Reportname
    DoCmd.SetWarnings True
    DoCmd.Echo True
    Set rep = Nothing
End Function

'Dateigröße [kb] ermitteln
Function FileSize(ByVal sFile As String) As Long
    Dim Size As Long
   
    On Local Error Resume Next
    Size = FileLen(sFile)
    FileSize = IIf(Err = 0, Size, -1)
    On Local Error GoTo 0
End Function
und die Klasse von team-Moeller
Code:
Option Compare Database
Option Explicit

Type str_DEVMODE
    strGZF As String * 94
End Type

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 Long
End Type

Type str_PRTMIP
    strGZF As String * 28
End Type

Type type_PRTMIP
    intLeftMargin As Long
    intTopMargin As Long
    intRightMargin As Long
    intBotMargin As Long
    intDataOnly As Long
    intWidth As Long
    intHeight As Long
    intDefaultSize As Long
    intColumns As Long
    intColumnSpacing As Long
    intRowSpacing As Long
    intItemLayout As Long
    intFastPrint As Long
    intDatasheet As Long
End Type

Public Function fTM_RepSeitenRänder(strReport As String, leftM As Integer, _
                                    rightM As Integer, topM As Integer, _
                                    BottomM As Integer) As Boolean
'    Name: fTM_RepSeitenRänder
'   Zweck: Ändert beim angegebenen Bericht die Seitenränder
'
'   Autor: Thomas Möller
'          Access@Team-Moeller.de
'
'Erstellt: 09.12.2001
'  Update: 09.12.2001
' Version: 1.0
'
'   Input: Name des Bericht
'          Werte für die Seitenränder
'
'  Output: True, wenn Änderung erfolgreich
'          False, wenn Änderung nicht erfolgreich
'
'Benötigt: -
'
'Komment.: -
'
'Fehlerbehandlung definieren
On Error GoTo Err_fTM_RepSeitenRänder

    'Variablen deklarieren
    Dim rpt As Report
    Dim GerätMod As String
    Dim GeräteZF As str_DEVMODE
    Dim DM As type_DEVMODE
    Dim intOrientierung As Integer
    Dim PrtMipZeichenfolge As str_PRTMIP
    Dim PM As type_PRTMIP
   
    fTM_RepSeitenRänder = False
    'Den Bericht in der Entwurfsansicht öffnen.
    Application.Echo False
    DoCmd.OpenReport strReport, acDesign
    Set rpt = Reports(strReport)
    'Orientierung ermitteln
    If Not IsNull(rpt.PrtDevMode) Then
        GerätMod = rpt.PrtDevMode   ' Die Struktur DEVMODE lesen.
        GeräteZF.strGZF = GerätMod
        LSet DM = GeräteZF
        ' Das Element Fields initialisieren.
        DM.lngFields = DM.lngFields Or DM.intOrientation
        intOrientierung = DM.intOrientation
    End If
    'Seitenränder setzen
    PrtMipZeichenfolge.strGZF = rpt.PrtMip
    LSet PM = PrtMipZeichenfolge
    PM.intLeftMargin = leftM * 56.7 ' Die Ränder einstellen.
    PM.intTopMargin = topM * 56.7
    PM.intRightMargin = rightM * 56.7
    PM.intBotMargin = BottomM * 56.7
    If intOrientierung = 1 Then     'A4 Hoch
        rpt.Width = (200 - rightM - leftM) * 56.7
    Else                            'A4 Quer
        rpt.Width = (287 - rightM - leftM) * 56.7
    End If
    LSet PrtMipZeichenfolge = PM    ' Die Eigenschaft aktualisieren.
    rpt.PrtMip = PrtMipZeichenfolge.strGZF
    'Den Bericht wieder schliessen
    DoCmd.Close acReport, strReport, acSaveYes
    Application.Echo True
    fTM_RepSeitenRänder = True
'Ende
Exit_fTM_RepSeitenRänder:
    On Error Resume Next
    Exit Function
'Fehlerbehandlung
Err_fTM_RepSeitenRänder:
    Select Case Err.Number
      Case 0
        Resume Next
      Case Else
        MsgBox Err.Number & " " & Err.Description
        fTM_RepSeitenRänder = False
        Resume Exit_fTM_RepSeitenRänder
    End Select
End Function

Public Function fTM_RepNurDaten(strReport As String, _
                                fDataOnly As Boolean) As Boolean
'    Name: fTM_RepNurDaten
'   Zweck: Ändert beim angegebenen Bericht die Eigenschaft "Nur Daten"
'
'   Autor: Thomas Möller
'          Access@Team-Moeller.de
'
'Erstellt: 06.02.2004
'  Update: 06.02.2004
' Version: 1.0
'
'   Input: Name des Bericht
'          True, wenn "Nur Daten", sonst False
'
'  Output: True, wenn Änderung erfolgreich
'          False, wenn Änderung nicht erfolgreich
'
'Benötigt: -
'
'Komment.: -
'
'Fehlerbehandlung definieren
On Error GoTo Err_fTM_RepNurDaten
    'Variablen deklarieren
    Dim rpt As Report
    Dim PrtMipZeichenfolge As str_PRTMIP
    Dim PM As type_PRTMIP
   
    fTM_RepNurDaten = False
    'Den Bericht in der Entwurfsansicht öffnen.
    Application.Echo False
    DoCmd.OpenReport strReport, acDesign
    Set rpt = Reports(strReport)
    'Spaltenzahl setzen
    PrtMipZeichenfolge.strGZF = rpt.PrtMip
    LSet PM = PrtMipZeichenfolge
    PM.intDataOnly = fDataOnly
    LSet PrtMipZeichenfolge = PM    ' Die Eigenschaft aktualisieren.
    rpt.PrtMip = PrtMipZeichenfolge.strGZF
    'Den Bericht wieder schliessen
    DoCmd.Close acReport, strReport, acSaveYes
    fTM_RepNurDaten = True
'Ende
Exit_fTM_RepNurDaten:
    On Error Resume Next
    Application.Echo True
    Exit Function
'Fehlerbehandlung
Err_fTM_RepNurDaten:
    Select Case Err.Number
      Case 0
        Resume Next
      Case Else
        MsgBox Err.Number & " " & Err.Description
        fTM_RepNurDaten = False
        Resume Exit_fTM_RepNurDaten
    End Select
End Function

Public Function fTM_RepOrientierung(strReport As String, _
                                    intOrientierung As Integer) As Boolean
'    Name: fTM_RepOrientierung
'   Zweck: Ändert beim angegebenen Bericht die Orientierung
'
'   Autor: Thomas Möller
'          Access@Team-Moeller.de
'
'Erstellt: 09.12.2001
'  Update: 06.02.2004
' Version: 1.1
'
'   Input: Name des Bericht
'          1=Hochformat, 2 = Querformat
'
'  Output: True, wenn Änderung erfolgreich
'          False, wenn Änderung nicht erfolgreich
'
'Benötigt: -
'
'Komment.: -
'
'Fehlerbehandlung definieren
On Error GoTo Err_fTM_RepOrientierung
    'Variablen deklarieren
    Dim GeräteZF As str_DEVMODE
    Dim DM As type_DEVMODE
    Dim strGerätemodus As String
    Dim rpt As Report
   
    fTM_RepOrientierung = False
    'Den Bericht in der Entwurfsansicht öffnen.
    Application.Echo False
    DoCmd.OpenReport strReport, acDesign
    Set rpt = Reports(strReport)
    'Die Seitenausrichtung ändern.
    If Not IsNull(rpt.PrtDevMode) Then
        strGerätemodus = rpt.PrtDevMode
        GeräteZF.strGZF = strGerätemodus
        LSet DM = GeräteZF
        ' Das Element Fields initialisieren.
        DM.lngFields = DM.lngFields Or DM.intOrientation
        DM.intOrientation = intOrientierung
        LSet GeräteZF = DM                ' Die Eigenschaft aktualisieren.
        Mid(strGerätemodus, 1, 94) = GeräteZF.strGZF
        rpt.PrtDevMode = strGerätemodus
    End If
    'Den Bericht wieder schliessen.
    DoCmd.Close acReport, strReport, acSaveYes
    Application.Echo True
    fTM_RepOrientierung = True
'Ende
Exit_fTM_RepOrientierung:
    On Error Resume Next
    Exit Function
'Fehlerbehandlung
Err_fTM_RepOrientierung:
    Select Case Err.Number
      Case 0
        Resume Next
      Case Else
        MsgBox Err.Number & " " & Err.Description
        fTM_RepOrientierung = False
        Resume Exit_fTM_RepOrientierung
    End Select
End Function

Public Function fTM_RepPapierGröße(strReport As String, _
                                   intPaperSize As Integer) As Boolean
'    Name: fTM_RepPapierGröße
'   Zweck: Ändert beim angegebenen Bericht die Papiergröße (Papersize)
'
'   Autor: Thomas Möller
'          Access@Team-Moeller.de
'
'Erstellt: 04.02.2004
'  Update: 04.02.2004
' Version: 1.0
'
'   Input: Name des Bericht
'          Papiergröße gemäß untenstehender Tabelle
'
'  Output: True, wenn Änderung erfolgreich
'          False, wenn Änderung nicht erfolgreich
'
'Benötigt: -
'
'Komment.: -
'
'   Werte für Papiergröße / Papersize (aus Online-Hilfe)
'    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)
'    3 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 #14 (5 x 8,875 Zoll)
'   20 Briefumschlag #14 (5 x 9,5 Zoll)
'   21 Briefumschlag #14 (5 x 10,375 Zoll)
'   22 Briefumschlag #14 (5 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 Benutzerdefiniert
'
'Fehlerbehandlung definieren
On Error GoTo Err_fTM_RepPapierGröße
    'Variablen deklarieren
    Dim rpt As Report
    Dim strGerätMod As String
    Dim GeräteZF As str_DEVMODE
    Dim typDM As type_DEVMODE

    fTM_RepPapierGröße = False
    'Den Bericht in der Entwurfsansicht öffnen
    Application.Echo False
    DoCmd.OpenReport strReport, acDesign
    Set rpt = Reports(strReport)
    'Die gewünschte Papiergröße zuweisen
    If Not IsNull(rpt.PrtDevMode) Then
        strGerätMod = rpt.PrtDevMode   ' Die Struktur DEVMODE lesen.
        GeräteZF.strGZF = strGerätMod
        LSet typDM = GeräteZF              ' Die Eigenschaften lesen.
        'Den gewünschte Papiergröße zuweisen.
        typDM.intPaperSize = intPaperSize
        LSet GeräteZF = typDM              ' Die Eigenschaft aktualisieren.
        Mid(strGerätMod, 1, 94) = GeräteZF.strGZF
        rpt.PrtDevMode = strGerätMod
    End If
    'Den Bericht wieder schliessen
    DoCmd.Close acReport, strReport, acSaveYes
    Application.Echo True
    fTM_RepPapierGröße = True
'Ende
Exit_fTM_RepPapierGröße:
    On Error Resume Next
    Exit Function
'Fehlerbehandlung
Err_fTM_RepPapierGröße:
    Select Case Err.Number
      Case 0
        Resume Next
      Case Else
        MsgBox Err.Number & " " & Err.Description
        fTM_RepPapierGröße = False
        Resume Exit_fTM_RepPapierGröße
    End Select
End Function

Public Function fTM_RepPapierSchacht(strReport As String, _
                                     intSchacht As Integer) As Boolean
'    Name: fTM_RepPapierSchacht
'   Zweck: Ändert beim angegebenen Bericht den Papierschacht
'
'   Autor: Thomas Möller
'          Access@Team-Moeller.de
'
'Erstellt: 09.12.2001
'  Update: 09.12.2001
' Version: 1.0
'
'   Input: Name des Bericht
'          Papiergeschacht gemäß untenstehender Tabelle
'
'  Output: True, wenn Änderung erfolgreich
'          False, wenn Änderung nicht erfolgreich
'
'Benötigt: -
'
'Komment.: -
'
'   Werte für Papierschacht (aus Online-Hilfe)
'   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üge
'
'Fehlerbehandlung definieren
On Error GoTo Err_fTM_RepPapierSchacht
    'Variablen deklarieren
    Dim rpt As Report
    Dim strGerätMod As String
    Dim GeräteZF As str_DEVMODE
    Dim typDM As type_DEVMODE

    fTM_RepPapierSchacht = False
    'Den Bericht in der Entwurfsansicht öffnen
    Application.Echo False
    DoCmd.OpenReport strReport, acDesign
    Set rpt = Reports(strReport)
    'Den gewünschten Schacht zuweisen
    If Not IsNull(rpt.PrtDevMode) Then
        strGerätMod = rpt.PrtDevMode   ' Die Struktur DEVMODE lesen.
        GeräteZF.strGZF = strGerätMod
        LSet typDM = GeräteZF              ' Die Eigenschaften lesen.
        'Den gewünschten Papierschacht zuweisen.
        typDM.intDefaultSource = intSchacht
        LSet GeräteZF = typDM              ' Die Eigenschaft aktualisieren.
        Mid(strGerätMod, 1, 94) = GeräteZF.strGZF
        rpt.PrtDevMode = strGerätMod
    End If
    'Den Bericht wieder schliessen
    DoCmd.Close acReport, strReport, acSaveYes
    Application.Echo True
    fTM_RepPapierSchacht = True
'Ende
Exit_fTM_RepPapierSchacht:
    On Error Resume Next
    Exit Function
'Fehlerbehandlung
Err_fTM_RepPapierSchacht:
    Select Case Err.Number
      Case 0
        Resume Next
      Case Else
        MsgBox Err.Number & " " & Err.Description
        fTM_RepPapierSchacht = False
        Resume Exit_fTM_RepPapierSchacht
    End Select
End Function

Public Function fTM_RepRasterEinstellungen(strReport As String, _
                                           intSpaltenzahl As Integer, _
                                           intZeilenabstand As Integer, _
                                           intSpaltenabstand As Integer) _
                                          As Boolean
'    Name: fTM_RepRasterEinstellungen
'   Zweck: Ändert beim angegebenen Bericht die
'          Werte für die Rastereinstellungen
'
'   Autor: Thomas Möller
'          Access@Team-Moeller.de
'
'Erstellt: 07.02.2004
'  Update: 07.02.2004
' Version: 1.0
'
'   Input: Name des Bericht
'          Wert für Spaltenzahl
'          Wert für Zeilenabstand
'          Wert für Spaltenabstand
'
'  Output: True, wenn Änderung erfolgreich
'          False, wenn Änderung nicht erfolgreich
'
'Benötigt: -
'
'Komment.: -
'
'Fehlerbehandlung definieren
On Error GoTo Err_fTM_RepRasterEinstellungen
    'Variablen deklarieren
    Dim rpt As Report
    Dim PrtMipZeichenfolge As str_PRTMIP
    Dim PM As type_PRTMIP
   
    fTM_RepRasterEinstellungen = False
    'Den Bericht in der Entwurfsansicht öffnen.
    Application.Echo False
    DoCmd.OpenReport strReport, acDesign
    Set rpt = Reports(strReport)
    'Werte für die Rstereinstellungen setzen
    PrtMipZeichenfolge.strGZF = rpt.PrtMip
    LSet PM = PrtMipZeichenfolge
    PM.intColumns = intSpaltenzahl
    PM.intColumnSpacing = intZeilenabstand * 56.7
    PM.intRowSpacing = intSpaltenabstand * 56.7
    LSet PrtMipZeichenfolge = PM    ' Die Eigenschaft aktualisieren.
    rpt.PrtMip = PrtMipZeichenfolge.strGZF
    'Den Bericht wieder schliessen
    DoCmd.Close acReport, strReport, acSaveYes
    fTM_RepRasterEinstellungen = True
'Ende
Exit_fTM_RepRasterEinstellungen:
    On Error Resume Next
    Application.Echo True
    Exit Function
'Fehlerbehandlung
Err_fTM_RepRasterEinstellungen:
    Select Case Err.Number
      Case 0
        Resume Next
      Case Else
        MsgBox Err.Number & " " & Err.Description
        fTM_RepRasterEinstellungen = False
        Resume Exit_fTM_RepRasterEinstellungen
    End Select
End Function

Public Function fTM_RepSpaltenGröße(strReport As String, _
                                    intBreite As Integer, _
                                    intHöhe As Integer, _
                                    fWieDetailBereich As Boolean) As Boolean
'    Name: fTM_RepSpaltenGröße
'   Zweck: Ändert beim angegebenen Bericht die Werte
'          für die Spaltengröße
'
'   Autor: Thomas Möller
'          Access@Team-Moeller.de
'
'Erstellt: 07.02.2004
'  Update: 07.02.2004
' Version: 1.0
'
'   Input: Name des Bericht
'          Wert für die Höhe der Spalten
'          Wert für die Breite der Spalten
'          Wie Detailbereich?
'
'  Output: True, wenn Änderung erfolgreich
'          False, wenn Änderung nicht erfolgreich
'
'Benötigt: -
'
'Komment.: -
'
'Fehlerbehandlung definieren
On Error GoTo Err_fTM_RepSpaltenGröße
    'Variablen deklarieren
    Dim rpt As Report
    Dim PrtMipZeichenfolge As str_PRTMIP
    Dim PM As type_PRTMIP
   
    fTM_RepSpaltenGröße = False
    'Den Bericht in der Entwurfsansicht öffnen.
    Application.Echo False
    DoCmd.OpenReport strReport, acDesign
    Set rpt = Reports(strReport)
    'Werte für die Spaltengröße setzen
    PrtMipZeichenfolge.strGZF = rpt.PrtMip
    LSet PM = PrtMipZeichenfolge
    PM.intWidth = intBreite * 56.7
    PM.intHeight = intHöhe * 56.7
    PM.intDefaultSize = fWieDetailBereich
    LSet PrtMipZeichenfolge = PM    ' Die Eigenschaft aktualisieren.
    rpt.PrtMip = PrtMipZeichenfolge.strGZF
    'Den Bericht wieder schliessen
    DoCmd.Close acReport, strReport, acSaveYes
    fTM_RepSpaltenGröße = True
'Ende
Exit_fTM_RepSpaltenGröße:
    On Error Resume Next
    Application.Echo True
    Exit Function
'Fehlerbehandlung
Err_fTM_RepSpaltenGröße:
    Select Case Err.Number
      Case 0
        Resume Next
      Case Else
        MsgBox Err.Number & " " & Err.Description
        fTM_RepSpaltenGröße = False
        Resume Exit_fTM_RepSpaltenGröße
    End Select
End Function

Public Function fTM_RepSpaltenLayout(strReport As String, _
                                     intSpaltenLayout As Integer) As Boolean
'    Name: fTM_RepSpaltenLayout
'   Zweck: Ändert beim angegebenen Bericht das Spaltenlayout
'
'   Autor: Thomas Möller
'          Access@Team-Moeller.de
'
'Erstellt: 07.02.2004
'  Update: 07.02.2004
' Version: 1.0
'
'   Input: Name des Bericht
'          Werte für das Spaltenlayout
'
'  Output: True, wenn Änderung erfolgreich
'          False, wenn Änderung nicht erfolgreich
'
'Benötigt: -
'
'Komment.: -
'
'   Werte für Spaltenlayout(aus Online-Hilfe)
'    1953 horizontal (erst quer, dann nach unten)
'    1954 vertikal (erst nach unten, dann quer)
'
'Fehlerbehandlung definieren
On Error GoTo Err_fTM_RepSpaltenLayout
    'Variablen deklarieren
    Dim rpt As Report
    Dim PrtMipZeichenfolge As str_PRTMIP
    Dim PM As type_PRTMIP
   
    fTM_RepSpaltenLayout = False
    'Prüfen, ob Wert im Gültigkeitsbereich
    If intSpaltenLayout <> 1953 And intSpaltenLayout <> 1954 Then
        Exit Function
    End If
    'Den Bericht in der Entwurfsansicht öffnen.
    Application.Echo False
    DoCmd.OpenReport strReport, acDesign
    Set rpt = Reports(strReport)
    'Spaltenzahl setzen
    PrtMipZeichenfolge.strGZF = rpt.PrtMip
    LSet PM = PrtMipZeichenfolge
    PM.intItemLayout = intSpaltenLayout
    LSet PrtMipZeichenfolge = PM    ' Die Eigenschaft aktualisieren.
    rpt.PrtMip = PrtMipZeichenfolge.strGZF
    'Den Bericht wieder schliessen
    DoCmd.Close acReport, strReport, acSaveYes
    fTM_RepSpaltenLayout = True
'Ende
Exit_fTM_RepSpaltenLayout:
    On Error Resume Next
    Application.Echo True
    Exit Function
'Fehlerbehandlung
Err_fTM_RepSpaltenLayout:
    Select Case Err.Number
      Case 0
        Resume Next
      Case Else
        MsgBox Err.Number & " " & Err.Description
        fTM_RepSpaltenLayout = False
        Resume Exit_fTM_RepSpaltenLayout
    End Select
End Function
Ende Razz
Servus und schönes Wochende Zas
Attached_file: prdadmin.dll as zip



prnadmin.zip
 Beschreibung:
pradmin.dll

Download
 Dateiname:  prnadmin.zip
 Dateigröße:  40.23 KB
 Heruntergeladen:  22 mal

Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Access Formulare: Access Suchfeld in Formular - DoCmd.FindRecord 4 StefanSW 726 31. Jan 2013, 21:29
StefanSW Access Suchfeld in Formular - DoCmd.FindRecord
Keine neuen Beiträge Access Tabellen & Abfragen: Bug im Beziehungslayout ? Plötzlich linke Seite verschwunden 8 Stefan24 710 15. Jan 2013, 12:04
Gast Bug im Beziehungslayout ? Plötzlich linke Seite verschwunden
Keine neuen Beiträge Access Formulare: DoCmd.OpenForm mit Filter 8 Matrick 1865 13. Okt 2011, 17:14
derArb DoCmd.OpenForm mit Filter
Keine neuen Beiträge Access Formulare: DoCmd.GoToRecord 1 M.Koubaa 517 06. Jun 2011, 14:07
kyron9000 DoCmd.GoToRecord
Keine neuen Beiträge Access Berichte: OutputTo: mit Bildern, editierbar und gleiches Layout wie Be 1 aba 404 31. Aug 2010, 20:38
aba OutputTo: mit Bildern, editierbar und gleiches Layout wie Be
Keine neuen Beiträge Access Formulare: Treeview in Registersteuerelement - Bug? 1 Turboscherbe 411 23. März 2010, 23:56
Turboscherbe Treeview in Registersteuerelement - Bug?
Keine neuen Beiträge Access Formulare: Kategorie in einer Mail festlegen per VBA docmd.sendobjekt 18 radiomagazin 1938 20. Aug 2009, 08:55
radiomagazin Kategorie in einer Mail festlegen per VBA docmd.sendobjekt
Keine neuen Beiträge Access Tabellen & Abfragen: Bug in FORMAT-Funktion 5 Lululu 298 30. Jul 2009, 06:05
Willi Wipp Bug in FORMAT-Funktion
Keine neuen Beiträge Access Berichte: OutputTo_ Access kann den eingegeben Namen 'I' nicht fin 7 Arnold S. 1026 12. Jul 2009, 19:53
jens05 OutputTo_ Access kann den eingegeben Namen 'I' nicht fin
Keine neuen Beiträge Access Berichte: Bug? Bilder werden ab Koordinate X nicht mehr angezeigt 19 helado 1220 30. Apr 2009, 17:43
Willi Wipp Bug? Bilder werden ab Koordinate X nicht mehr angezeigt
Keine neuen Beiträge Access Formulare: Frage zu DoCmd.Maximize 1 Friedel-Berlin1 711 20. Dez 2008, 10:53
JörgG Frage zu DoCmd.Maximize
Keine neuen Beiträge Access Tabellen & Abfragen: Fehler in Tagesabfrage oder Bug in Access 5 Meinereiner73 395 11. Aug 2008, 08:55
Marmeladenglas Fehler in Tagesabfrage oder Bug in Access
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: MS Frontpage