Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
664to668
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
664to668
664to668
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Druckserver spammen durch VBA ?

Druckserver spammen durch VBA ?
13.09.2005 09:03:24
Klaus
Moin,
Ich brauche 250 A5 Zettel mit fortlaufenden Nummern (groß und gut lesbar, um Paletten in der Produktion zu markieren), daher habe mir gerade folgendes kleines Makro geschrieben:


Sub Makro1()
For x = 250 To 1 Step -1
ActiveSheet.Shapes("WordArt 1").Select
Selection.ShapeRange.TextEffect.Text = (x)
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next x
End Sub


funktioniert auch super, mein Drucker glüht. Allerdings hat mich zwei Minuten nach Makrostart unser Admin angerufen und ganz aufgelöst gefragt, was zur Hölle ich mit dem Druckserver angestellt hätte.
Drum mal in die Runde gefragt:
Gibt es für sowas auch elegantere Lösungen?
Gruß,
Klaus M.vdT.

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Druckserver spammen durch VBA ?
13.09.2005 09:20:16
Martin
Hallo,
damit der Admin durch die Menge der Druckaufträge nicht erschlagen wird, solltest Du vielleicht eine kleine Pause von einigens Sekunden in die Schleife einbauen!

Sub Makro1()
For x = 250 To 1 Step -1
ActiveSheet.Shapes("WordArt 1").Select
Selection.ShapeRange.TextEffect.Text = (x)
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 10
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
Next x
End Sub

Es müsse nicht 10 Sekunden sein, du kannst ja die Zeit der Druckdauer pro Blatt als Pausenzeit verwenden!
Anzeige
AW: Druckserver spammen durch VBA ?
13.09.2005 09:22:59
Martin
oder so ist es weniger vba-code:
waitTime = TimeSerial(0, 0, 10)
AW: Druckserver spammen durch VBA ?
13.09.2005 10:15:29
Klaus
Hallo Martin,
danke für den Tip, klingt gut. Kann ich die Druckzeit in VBA feststellen? Ich denke an irgendwas in der Richtung "application.wait until druckauftrag(x).fertig = true" ?
Zwischenzeitlich habe ich die Zettel per Hand und Edding angefertigt, ging schneller als auf den Drucker zu warten. Wie ich gerade erfahren habe, haben meine Druckaufträge den Druckserver abgeschossen (uralte Win2k Kiste) und ich kriege jetzt einen lokal angeschlossenen Drucker :)
Dank und Gruß,
Klaus M.vdT.
AW: Druckserver spammen durch VBA ?
13.09.2005 10:30:11
Nepumuk
Hallo Klaus,
unter nicht geklärten Umständen, verdoppelt sich die Größe der aktuellen Datei im Druckerspool. Festzustellen, ob eine Datei schon abgearbeitet wurde, ist schwierig. Mal ein Beispielcode, der aber noch angepasst werden müsste:
' **********************************************************************
' Modul: modCheckPrinter Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

'Deklaration der API - Funktionen

Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
    "OpenPrinterA" (ByVal pPrinterName As String, phPrinter _
    As Long, pDefault As Any) As Long

Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal _
    hPrinter As Long) As Long

Private Declare Function EnumJobs Lib "winspool.drv" Alias _
    "EnumJobsA" (ByVal hPrinter As Long, ByVal FirstJob _
    As Long, ByVal NoJobs As Long, ByVal Level As Long, _
    pJob As Any, ByVal cdBuf As Long, pcbNeeded As Long, _
    pcReturned As Long) As Long

Private Declare Function EnumPrinters Lib "winspool.drv" Alias _
    "EnumPrintersA" (ByVal flags As Long, ByVal name As String, _
    ByVal Level As Long, pPrinterEnum As Long, ByVal cdBuf _
    As Long, pcbNeeded As Long, pcReturned As Long) As Long

Private Declare Function lstrlen Lib "kernel32.dll" Alias _
    "lstrlenA" (ByVal lpString As Long) As Long

Private Declare Function lstrcpy Lib "kernel32.dll" Alias _
    "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 _
    As Long) As Long

Private Declare Sub MoveMemory Lib "kernel32" Alias _
    "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen _
    As Long)

Private Declare Function GetInputState Lib "user32" () As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds _
    As Long)

'Deklaration der Konstanten und Variablen
Private Enum PrinterConst
    PRINTER_ENUM_LOCAL = &H2
    PRINTER_ENUM_FAVORITE = &H4
End Enum

Public g_NumCalls As Integer
Private m_arrPrinted(0 To 10) As Boolean

'Durch Zeichenfolgenvergleich wird ermittelt, ob für die Arbeitsmappe
'eine Datei im Spoolordner vorliegt. Dazu wird erst die "handle" -
'Nummer des Druckers ermittelt und anschließend alle im Spoolordner
'vorliegenden Dateien und deren Eigenschaften in das Array "lngData"
'ausgegeben. Die Dateinamen werden in den String "Job" kopiert,
'welcher anschließend mit dem übergebenen Arbeitsmappen-Namen
'verglichen wird.

Private Function FileInSpool(sFileName As String) As Boolean
    Dim lngRetval As Long, lngPrinter As Long, intIndex As Integer
    Dim lngData() As Long, lngDataLength As Long, lngJobCount As Long
    Dim strJob As String
    OpenPrinter Printer(ActivePrinter), lngPrinter, ByVal 0&
    lngRetval = EnumJobs(lngPrinter, 0&, 256&, 2&, ByVal 0&, 0&, _
        lngDataLength, lngJobCount)
    If lngDataLength = 0 And lngRetval <> 0 Then
        Call ClosePrinter(lngPrinter)
        Exit Function
    End If
    Redim lngData(lngDataLength - 1)
    lngRetval = EnumJobs(lngPrinter, 0&, 256&, 2&, lngData(0), _
        lngDataLength, lngDataLength, lngJobCount)
    For intIndex = 0 To lngJobCount - 1
        CopyStrVar strJob, lngData(intIndex * 26 + 4)
        If sFileName = strJob Then FileInSpool = True: Exit For
    Next
    Call ClosePrinter(lngPrinter)
End Function

'Diese Funktion kopiert den Inhalt des Arbeitsspeichers unter Angabe
'der Adresse und der zu kopierenden Länge in eine Variable.

Private Function CopyStrVar(ByRef StrDest As String, ByRef VarSrc As Long)
    StrDest = Space(lstrlen(VarSrc))
    MoveMemory ByVal StrDest, ByVal VarSrc, Len(StrDest)
End Function

'Ermitteln der internen Druckerbezeichnung duch Zeichenfolgenvergleich,
'da diese von der Bezeichnung des aktiven Druckers abweichen kann.
'Erst wird versucht die lokalen Drucker zu ermitteln. Ist kein lokaler
'Drucker angeschlossen, werden alle im Betriebssystem deklarierten
'Drucker ermittelt.

Private Function Printer(strPrintername As String) As String
    Dim lngBuffer() As Long, lngBytes As Long, intIndex As Integer
    Dim lngNeeded As Long, lngPrinters As Long, lngReturn As Long
    lngBytes = 3076
    Redim lngBuffer(0 To lngBytes / 4) As Long
    lngReturn = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, _
        lngBuffer(0), lngBytes, lngNeeded, lngPrinters)
    If lngReturn = 0 Then
        lngBytes = lngNeeded
        Redim lngBuffer(0 To lngBytes / 4) As Long
        lngReturn = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, _
            lngBuffer(0), lngBytes, lngNeeded, lngPrinters)
        If lngReturn = 0 Then
            lngReturn = EnumPrinters(PRINTER_ENUM_FAVORITE, "", 1, _
                lngBuffer(0), lngBytes, lngNeeded, lngPrinters)
            If lngReturn = 0 Then
                lngBytes = lngNeeded
                Redim lngBuffer(0 To lngBytes / 4) As Long
                lngReturn = EnumPrinters(PRINTER_ENUM_FAVORITE, "", 1, _
                    lngBuffer(0), lngBytes, lngNeeded, lngPrinters)
            End If
        End If
    End If
    For intIndex = 0 To lngPrinters - 1
        Printer = Space(lstrlen(lngBuffer(4 * intIndex + 2)))
        lstrcpy Printer, lngBuffer(4 * intIndex + 2)
        If InStr(1, strPrintername, Printer) <> 0 Then
            Exit Function
        End If
    Next
    MsgBox "Fehler bei der Druckersuche. Programmabbruch.", _
        16, "Warnung": End
End Function

'Diese Routine prüft eine Sekunde lang, im Intervall von 100 Millisekunden,
'ob für diese Mappe, unter dem aktiven Drucker, eine Datei im Spoolordner
'angekommen ist.

Public Sub CheckPrinter()
    Static st_NumCalls As Integer
    Dim intIndex As Integer
    Dim blnPrinted As Boolean
    st_NumCalls = st_NumCalls + 1
    Debug.Print "st_NumCalls: " & st_NumCalls
    Debug.Print "g_NumCalls: " & g_NumCalls
    blnPrinted = False
    For intIndex = 1 To 20
        If FileInSpool(ThisWorkbook.name) Then
            blnPrinted = True
            Exit For
        End If
        Sleep 100
        If GetInputState Then DoEvents
    Next
    If g_NumCalls = 1 Then
        If blnPrinted Then
            MsgBox "Es wurde ein Druckauftrag an den Drucker geschickt! (g_NumCalls = 1)"
            blnPrinted = False
        Else
            MsgBox "Es wurde k e i n Druckauftrag an den Drucker geschickt! (g_NumCalls = 1)"
        End If
        g_NumCalls = 0
        st_NumCalls = 0
    Else
        If st_NumCalls < g_NumCalls Then
            m_arrPrinted(st_NumCalls) = blnPrinted
            Debug.Print "If st_NumCalls < g_NumCalls: " & st_NumCalls
        Else
            'Letzter Durchgang
            m_arrPrinted(st_NumCalls) = blnPrinted
            Dim n As Long
            blnPrinted = False
            For n = LBound(m_arrPrinted) To UBound(m_arrPrinted)
                If m_arrPrinted(n) = True Then
                    blnPrinted = True
                    m_arrPrinted(n) = False
                End If
            Next
            If blnPrinted Then
                MsgBox "Es wurde ein Druckauftrag an den Drucker geschickt!"
            Else
                MsgBox "Es wurde k e i n Druckauftrag an den Drucker geschickt!"
            End If
            st_NumCalls = 0
            g_NumCalls = 0
        End If
    End If
End Sub

Gruß
Nepumuk

Anzeige
AW: Druckserver spammen durch VBA ?
13.09.2005 12:44:55
Klaus
Hui!
Ich versteh zwar kein Wort, aber es sieht interessant aus. Das ganze jetzt noch anpassen .. bei meinem VBA Level denke ich mal, ich werde bei der Lösung "3 Sekunden warten" bleiben :) Ich speichere mir das aber und schau mir das zu hause in aller Ruhe an, man lebt schließlich um zu lernen.
Vielen Dank,
Klaus M.vdT.
AW: Druckserver spammen durch VBA ?
13.09.2005 09:22:15
Nepumuk
Hallo Klaus,
Vorschlag:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Declare Sub Sleep Lib "kernel32.dll" ( _
    ByVal dwMilliseconds As Long)

Sub Makro1()
    For x = 250 To 1 Step -1
        ActiveSheet.Shapes("WordArt 1").Select
        Selection.ShapeRange.TextEffect.Text = (x)
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
        Sleep 3000 ' 3 Sekunden warten
    Next x
End Sub

Das Makro wartet, nach jedem Druckauftrag, 3 Sekunden. Die Wartezeit solltest du so einstellen, dass der nächste Auftrag erst nach dem beenden des vorhergehenden losgeschickt wird. Dann meckert dein Admin sicher nicht.
Gruß
Nepumuk

Anzeige
AW: Druckserver spammen durch VBA ?
13.09.2005 10:39:49
Klaus
Hallo Nepumuk!
Danke für den Code, habe das Problem zwischenzeitlich auf die althergebrachte Weise gelöst (Edding und Handschrift).
Deinen und auch Martins Code speichere ich aber und probier ihn zuhause noch mal aus - hier hab ich erstmal Druckverbot :-) j/k

Option Explicit
Declare Sub Sleep Lib "kernel32.dll" ( _
ByVal dwMilliseconds As Long)

Die Codezeilen verstehe ich nicht. Was ist eine "Option Explicit"? Die "kernel32.dll" habe ich zwar auf diesem Rechner - aber gibt es die in allen Windows / Office Versionen?
Gruß,
Klaus M.vdT:
AW: Druckserver spammen durch VBA ?
13.09.2005 10:57:36
Nepumuk
Hallo Klaus,
die Anweisung "Option Explicit" zwingt dich alle verwendeten Variablen explizit zu deklarieren. Das macht Makros schneller, spart Stapelspeicher und erleichtert die Fehlersuche ungemein, da ein Schreibfehler in einer Variablen beim kompilieren angemeckert wird.
Die kernell32.dll gibt es in jeder Windows - Version. Sie hat den Vorteil, dass dein Prozessor beim Warten nicht belastet wird, während die Wait - Methode ihn zu 100% auslastet.
Gruß
Nepumuk

Anzeige
AW: Druckserver spammen durch VBA ?
13.09.2005 12:51:45
Klaus
*lern*
Super, das bringt mich ganz nebenbei in anderen Projekten weiter, falls ich mal Wartezeiten einbauen muss.
Option Explicit werde ich mal über ein paar meiner Codes schreiben und schauen was passiert - schneller ist immer gut. Variablen explizit zu deklarieren heisst, immer "dim x as integer" zu schreiben wenn ich einen Wert x benutze?
Auch hier nochmal vielen Dank,
Klaus M.vdT.
Vor zwei Monaten konnte ich noch nicht mal Makros auf Buttons legen - dieses Forum ist dank Usern wie euch besser als jede Fortbildungsmaßnahme!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige