Office: Do...Loop mit Tastatur abbrechen

Helfe beim Thema Do...Loop mit Tastatur abbrechen in Microsoft Access Hilfe um das Problem gemeinsam zu lösen; Hallo Oski, bei uns blamiert sich niemand. Wir haben schließlich alle mal angefangen und waren froh, wenn jemand da war, der uns geholfen hat. Daher... Dieses Thema im Forum "Microsoft Access Hilfe" wurde erstellt von OskiH, 2. Februar 2003.

Seite 2 von 3

AQUARII

Aquarii

Do...Loop mit Tastatur abbrechen

Hallo Oski,

bei uns blamiert sich niemand. Wir haben schließlich alle mal angefangen und waren froh, wenn jemand da war, der uns geholfen hat.

Daher folgender Vorschlag auf Basis von dem von Mario:

Variable Modulweit deklarieren:
Code:

Dim blnSchleife As Boolean
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = 27 Then blnSchleife = False

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

Private Sub DoCmd_LaufzettelDrucken_Click()
On Error GoTo Err

Dim rs As Dao.Recordset
Dim Ende As Long

'Recordset auf Unterformular
Set rs = Forms!frmLaufzettel.Form!fsubLaufzettel.Form.RecordsetClone

'Recordset aktualisieren
rs.Requery

'Gehe auf ersten Datensatz
rs.MoveFirst

'Variable initialisieren
blnSchleife =true

'Schleife solange durchlaufen bis letzter Datensatz erreicht oder
' Escape gedrückt
Do While rs.EOF = False or blnSchleife

If rs!LaufzettelAnzahl > rs!LaufzettelGedruckt Then
DoCmd.Hourglass True
Rem: Oeffnen Bericht und drucken
DoCmd.OpenReport ReportName:="rptLaufzettel",
View:=acViewNormal, WhereCondition:="AuftragID=" & Me!AuftragID
rs.Edit
Rem: LaufzettelGedruckt um eine Zahl erhöhen
rs!LaufzettelGedruckt = rs!LaufzettelGedruckt + 1
rs.Update
Rem: Warten x Sekunden, dann nächster Laufzettel drucken
Ende = Timer + 5
Do
If Ende < Timer Then Exit Do
Loop

Else

Rem: Schliessen Bericht
DoCmd.Close acReport, ObjectName:="rptLaufzettel"
rs.MoveNext

End If

Loop
if blnSchleife = false then goto Verlassen

DoCmd.Hourglass False
' Wenn letzter Datensatz dann MsgBox
rs.MoveLast
MsgBox "Alle Laufzettel gedruckt!", vbInformation, "Information"

Verlassen:
rs.Close
set rs = nothing

exit Sub

'Fehlermeldung
Err:
Exit Sub

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Aquarii, 4. Februar 2003

#16
OSKIH

OskiH

Hi Aquarii

Ist super genial wenn man sogeduldige Helfer hat. Muss den Code gleich ausprobieren. Melde mich wieder.

Oski

OskiH, 4. Februar 2003

#17
NOUBA

Nouba

Hallo Oski,

so würde Norberts Tastaturabbruchbedingung ausschauen. Wenn Heikos Variante funktioniert, bleibe dabei.

Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" (pbKeyState As Byte) As Long

Private Const VK_ESCAPE = &H1B

Private Sub DoCmd_LaufzettelDrucken_Click()
On Error GoTo Err

Dim rs As DAO.Recordset
Dim Ende As Long
Dim arrTasten(0 To 255) As Byte

Rem:Recordset auf Unterformular
Set rs = Me!fsubLaufzettel.Form.RecordsetClone

Rem: Recordset aktuallisieren
' braucht man vermutlich nicht
' rs.Requery

Rem: Gehe auf ersten Datensatz
rs.MoveFirst

Rem: Schleife solange durchlaufen bis letzter Datensatz erreicht
Do While Not rs.EOF
DoEvents
GetKeyboardState arrTasten(0)
If arrTasten(VK_ESCAPE) And 1 Then
arrTasten(VK_ESCAPE) = arrTasten(VK_ESCAPE) And Not 1
SetKeyboardState arrTasten(0)
SysCmd acSysCmdSetStatus, "Schleife mit Tastatur abgebrochen"
Exit Do
End If
If rs!LaufzettelAnzahl > rs!LaufzettelGedruckt Then
DoCmd.Hourglass True

Rem: Oeffnen Bericht und drucken
DoCmd.OpenReport "rptLaufzettel", , , "AuftragID=" & Me!AuftragID

rs.Edit
Rem: LaufzettelGedruckt um eine Zahl erhöhen
rs!LaufzettelGedruckt = rs!LaufzettelGedruckt + 1
rs.Update

Rem: Warten x Sekunden, dann nächster Laufzettel drucken
Ende = Timer + 5
Do
If Ende < Timer Then Exit Do
Loop
Else
Rem: Schliessen Bericht
DoCmd.Close acReport, ObjectName:="rptLaufzettel"
rs.MoveNext
End If
Loop
DoCmd.Hourglass False

Rem: Wenn letzter Datensatz dann MsgBox
' rs.MoveLast
MsgBox "Alle Laufzettel gedruckt!", vbInformation, "Information"
Rem:Fehlermeldung
Err:
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Nouba, 4. Februar 2003

#18
OSKIH

OskiH

Do...Loop mit Tastatur abbrechen

Hallo

@Aquari
Das Abbrechen funktioniert *Sun. Vielen Dank. Zwei Dinge sind noch: 1. Bei der Sanduhr habe ich noch einen Fehler und 2. Schön wäre es, wenn ich eine MsgBox hätte wenn ich die Schleife abbreche, die den Benutzer darauf aufmerksam macht.

@Nouba
Ich habe eine Lösung, die funktioniert aber ich werde deine auch ausprobieren. Uebung macht den Meister.

Oski

OskiH, 4. Februar 2003

#19
AQUARII

Aquarii

Hallo OskiH,

1. Bei der Sanduhr habe ich noch einen Fehler
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ja, da das Rücksetzen des Sanduhr bei Verlassen übersprungen wird. Also ändere entsprechend die Passage:

Code:

Loop
DoCmd.Hourglass False
if blnSchleife = false Then GoTo Verlassen
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Damit wird erst die Sanduhr zurückgesetzt und dann die Prozedur verlassen, nachdem Recordset geschlossen wurde.

2. Schön wäre es, wenn ich eine MsgBox hätte wenn ich die Schleife abbreche
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

Loop
DoCmd.Hourglass False
if blnSchleife = false Then
Msgbox "Sie haben den Vorgang abgebrochen"
GoTo Verlassen
end if
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Aquarii, 4. Februar 2003

#20
MARIOR

MarioR

Da goto-Programmierung kein schöner Programmierstil ist, vielleicht noch 'ne kleine Verbesserung: *wink.gif*

Code:

...
Loop

DoCmd.Hourglass False

If blnSchleife Then
MsgBox "Alle Laufzettel gedruckt!", vbInformation, "Information"
Else
Msgbox "Sie haben den Vorgang abgebrochen"
End If

rs.Close
Set rs = Nothing
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

MarioR, 4. Februar 2003

#21
AQUARII

Aquarii

Guten Morgen Mario,

ich gebe Dir natürlich Recht, danke für die Verbesserung *top

Aquarii, 4. Februar 2003

#22
OSKIH

OskiH

Do...Loop mit Tastatur abbrechen

Hi

Ich habe beide Varianten mit der MsgBox versucht und beide Male erscheint sie nicht, was ist blos falsch? Das mit der Sanduhr funkt auch nicht, muss wohl ohne gehen. Wäre jedoch schön gewesen.

Oski

OskiH, 5. Februar 2003

#23
NOUBA

Nouba

Hallo Oski,

Du könntest mal folgende Änderungen versuchen zu implementieren:

Hourglass-Geschichten in das OnOpen und OnClose Ereignis des Reports verfrachten.

Den Report nur 1x öffnen und anschließend unsichtbar machen, Du willst ja schließlich "nur" drucken. Das spart IMO etwas Zeit.

Anschließend mit Docmd.PrintOut ausdrucken - hier besteht die Möglichkeit, die Anzahl der Ausdrucke mitanzugeben (siehe OL-Hilfe).

Danach müßte nur einmal das Recordset "geupdatet" werden.

Ans Ende sollte noch ein Set rs = Nothing gesetzt werden, damit belegter Speicher auch wieder freigegeben wird.

Die Fehlerbehandlung würde ich in der Entwicklungsphase mal auskommentieren, um festzustellen, ob der Kode sauber abgearbeitet wird.

Stimmt es, das die Routine aus dem Hauptformular aufgerufen wird, das auch das Unterformular enthält, von dem die Daten stammen? - Davon bin ich ausgegangen.

Traust Du Dir das alleine zu?

PS: Problematisch könnte es werden, wenn beim Ausdrucken etwas schief geht. Dann stimmt natürlich LaufzettelGedruckt nicht mehr.

Nouba, 5. Februar 2003

#24
OSKIH

OskiH

\@Nouba

Ich glaube ich habe mich ein bisschen aufs Eis gewagt.

Stimmt es, das die Routine aus dem Hauptformular aufgerufen wird, das auch das Unterformular enthält, von dem die Daten stammen? - Davon bin ich ausgegangen.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ja, der Button, der die Schleife zum Drucken auslöst ist im Hauptformular.

Traust Du Dir das alleine zu?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich glaube wenn ich selber etwas wurschte kommt es sicher nicht gut. Ich habe den Eindruck, dass ich vor dem Lösen dieses Problem zuerst richtig Porgrammieren lernen müsste.

Oski

OskiH, 5. Februar 2003

#25
NOUBA

Nouba

Hallo Oski,

versuche mal folgendes einzuarbeiten (ungetestet)

Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" (pbKeyState As Byte) As Long

Private Const VK_ESCAPE = &H1B ' 27

Private Sub cmdLaufzettelDrucken_Click()
Dim rs As DAO.Recordset
Dim sngEnde As Single
Dim arrTasten(0 To 255) As Byte

On Error GoTo cmdLaufzettelDrucken_Click_Error

' Recordset des Unterformulars an Objektvariable zuweisen
Set rs = Me!fsubLaufzettel.Form.RecordsetClone

' Wir beginnen mit dem ersten Datensatz
rs.MoveFirst

' Schleife solange durchlaufen, bis letzter Datensatz erreicht
Do While Not rs.EOF
' damit auch andere Prozesse rechnen können
DoEvents

' Tastaturstatus abfragen
' Schleife bei ESC verlassen
GetKeyboardState arrTasten(0)
If arrTasten(VK_ESCAPE) And 1 Then
arrTasten(VK_ESCAPE) = arrTasten(VK_ESCAPE) And Not 1
SetKeyboardState arrTasten(0)
SysCmd acSysCmdSetStatus, "Schleife mit Tastatur abgebrochen"
Exit Do
End If

' Report öffnen
DoCmd.OpenReport "rptLaufzettel", , , "AuftragID=" & Me!AuftragID

' Report nicht anzeigen
Reports("rptLaufzettel").Visible = False

' Laufzettel sooft drucken, wie in Feld LaufzettelAnzahl steht
' wenn Laufzettel mehrmals gedruckt werden können,
' müßte die zu druckende Anzahl berechnet werden
' Gesamtauflage - LaufzettelGedruckt
DoCmd.PrintOut , , , , rs!LaufzettelAnzahl

' Anzahl bisher gedruckter Laufzettel aktualisieren
rs.Edit
' Feldinhalt ändern
rs!LaufzettelGedruckt = rs!LaufzettelAnzahl
' Datensatz schreiben
rs.Update

' Wenn's halt schön macht
' 5 Sekunden warten, dann nächsten Laufzettel drucken
sngEnde = Timer + 5

Do While sngEnde < Timer
Loop

' Bericht schliessen
DoCmd.Close acReport, "rptLaufzettel"

' ... und nächsten Laufzettel drucken
rs.MoveNext
Loop

' damit die geänderten Daten im UFO sichtbar werden
Me!fsubLaufzettel.Form.Requery

If rs.EOF Then MsgBox "Alle Laufzettel wurden gedruckt!", vbInformation, "Information"

RausHier:
Set rs = Nothing
On Error GoTo 0
Exit Sub

cmdLaufzettelDrucken_Click_Error:
MsgBox "Fehler " & Err.Number & " (" & Err.Description & ") in Prozedur cmdLaufzettelDrucken_Click"
Resume RausHier
End Sub

' Kode für den Bericht
'
Private Sub Report_Close()
DoCmd.Hourglass False
End Sub

Private Sub Report_Open(Cancel As Integer)
DoCmd.Hourglass True
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Nouba, 5. Februar 2003

#26
OSKIH

OskiH

Hi

@Nouba

Vorab. Ich staune immer wieder wie du dir Mühe gibst anderen zu Helfen. Super. *top

Ich habe meinen ganzen Code weggeputzt und deinen eingefügt(deiner sieht professioneller aus als mein gewurschtel)
Ich erhalte eine Fehlermeldung- Nr. 2451- ich verweise auf einen Bericht, der falsch geschrieben ist, nicht existiert oder nicht geöffnet ist.
In der Druckeranzeige erscheint jedoch die Anzahl Laufzettel für den ersten Datensatz, die Zahl im Feld LaufzettelGedruckt wird jedoch nicht hochgezählt.

OskiH, 5. Februar 2003

#27
NOUBA

Nouba

Do...Loop mit Tastatur abbrechen

Hallo Oski,

die Warteschleife war vermutlich die Ursache. Ich hatte fälschlich verwendet, dadurch hat sich eine Endlosschleife. Siehe auch die Anmerkung ^^^ im Kode. Zur besseren Übersicht ist der Kode in zwei Abschnitte aufgeteilt. Der oberre Abschnitt wäre in einem allgemeinen Modul zu verwenden. Der untere Abschnitt gehörte zur Form. Das Geschnörkel in der Statuszeile und die zusätzliche Wartezeit kann nach Belieben entfernt werden. Der Kode ist nach wie vor ungetestet.

' MODUL
'
Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" (pbKeyState As Byte) As Long

Public Function TasteGedrueckt(ByVal intKeyCode As Integer) As Boolean
Dim arrTasten(0 To 255) As Byte

' Tastaturstatus in Array holen
GetKeyboardState arrTasten(0)
If arrTasten(intKeyCode) And 1 Then
TasteGedrueckt = True
arrTasten(intKeyCode) = arrTasten(intKeyCode) And Not 1
SetKeyboardState arrTasten(0)
End If
End Function

' FORM
'

Private Sub cmdDruckeAuftraege_Click()
Const VK_ESCAPE As Integer = &H1B ' Escape Taste

Dim rs As DAO.Recordset
Dim sngEnde As Single

On Error GoTo Fehlerbehandlung

' Recordset des Unterformulars an Objektvariable zuweisen
Set rs = Me!fsubLaufzettel.Form.RecordsetClone

' Wir beginnen mit dem ersten Datensatz
rs.MoveFirst

' Schleife solange durchlaufen, bis letzter Datensatz erreicht
Do While Not rs.EOF
' damit auch andere Prozesse rechnen können
DoEvents

' Tastaturstatus abfragen
' Schleife bei ESC verlassen
If TasteGedrueckt(VK_ESCAPE) Then
' Ausgabe in Statuszeile
SysCmd acSysCmdSetStatus, "Schleife mit Tastatur abgebrochen"

sngEnde = Timer + 2

Do While sngEnde > Timer
' 2 Sekunden Meldung anzeigen
DoEvents
Loop

Exit Do
End If

' Report öffnen
DoCmd.OpenReport "rptLaufzettel", , , "AuftragID=" & Me!AuftragID

' Report nicht anzeigen
Reports("rptLaufzettel").Visible = False

' Laufzettel sooft drucken, wie in Feld LaufzettelAnzahl steht
' wenn Laufzettel mehrmals gedruckt werden können,
' müßte die zu druckende Anzahl berechnet werden
' Gesamtauflage - LaufzettelGedruckt
DoCmd.PrintOut , , , , rs!LaufzettelAnzahl

' Anzahl bisher gedruckter Laufzettel aktualisieren
rs.Edit
' Feldinhalt ändern
rs!LaufzettelGedruckt = rs!LaufzettelAnzahl
' Datensatz schreiben
rs.Update

' Bericht schliessen
DoCmd.Close acReport, "rptLaufzettel"

' ... und nächsten Laufzettel drucken
rs.MoveNext

' Wenn's halt schön macht
sngEnde = Timer + 5

' 5 Sekunden warten, dann nächsten Laufzettel drucken
Do While sngEnde > Timer
' ^^^
' hier lag vermutlich der Fehler
DoEvents
Loop
Loop

' damit die geänderten Daten im UFO sichtbar werden
Me!fsubLaufzettel.Form.Requery

If rs.EOF Then
MsgBox "Alle Laufzettel wurden gedruckt!", vbInformation, "Information"
Else
MsgBox "Es wurden nicht alle Laufzettel gedruckt!", vbInformation, "Information"
End If

RausHier:
Set rs = Nothing
' Statuszeile zurücksetzen
SysCmd acSysCmdSetStatus, " "
On Error GoTo 0
Exit Sub

Fehlerbehandlung:
MsgBox "Fehler " & Err.Number & " (" & Err.Description & ") in Prozedur cmdDruckeAuftraege_Click"
Resume RausHier
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Nouba, 5. Februar 2003

#28
OSKIH

OskiH

\@Nouba

Vielen Dank für deinen Code. Habe in bereits versucht und das Resultat ist immer noch die gleiche Fehlermeldung. Ich glaube ich werde es bei diesem Ergebnis bewenden lassen und mich mit der Version ohne MsgBox zufrieden geben. Ein Kollege sagte heute zu mir, dass die Software nie fertig ist und wenn sie fertig sein soll, muss man sie dem Entwickler wegnehmen. Ich bin jetzt an dem Punkt angelangt wo ich mir die Software selber wegnehme.

Oski

OskiH, 6. Februar 2003

#29
NOUBA

Nouba

Hallo Oski,

Zuerst muß herausgefunden werden, ob ein Programmfehler vorliegt oder ob die Daten inkonsistent sind.

Ist die AuftragID immer richtig versorgt? In welcher Zeile hängt der Kode? Stimmen die Namen des Berichts überall mit dem Originalnamen überein. Wann kommt der Fehler in der Schleife zustande?

mit F9 läßt sich ein Haltepunkt in einer Kodezeile setzen. Bei Ausführung bleibt der Kode an dieser Stelle stehen. Mit F8 kann man dann Zeile für Zeile des Kodes abarbeiten. Variableninhalte können durch drüberfahren mit der Maus eingesehen werden.

Nouba, 6. Februar 2003

#30

(Du musst angemeldet oder registriert sein, um eine Antwort erstellen zu können.)

Seite 2 von 3

Thema:

Do...Loop mit Tastatur abbrechen

Die Seite wird geladen...

Do...Loop mit Tastatur abbrechen - Similar Threads - Loop Tastatur abbrechen
Stundenzettel, VBA, MoveNext funktioniert nicht
in Microsoft Access Hilfe
Stundenzettel, VBA, MoveNext funktioniert nicht: Hallo, ich habe folgendes Problem und bin um jeden Denkanstoß sehr dankbar! Tabelle tblLOG: Daten einer Stechuhr; Datum, Uhrzeit, Mitarbeiter Tabelle tblKalender: alle Kalendertage bis zum Jahr...
Bestimmte Daten zwischen innerhalb eines Datumsbereichs einer Tabelle Anfügen
in Microsoft Access Hilfe
Bestimmte Daten zwischen innerhalb eines Datumsbereichs einer Tabelle Anfügen: Hallo, ich habe per Google und Foren SuFu leider nichts passendes finden können, wage aber zu bezweifeln, dass Access da an seine Grenzen kommt, da es eigentlich recht banal ist. Ich habe eine...
VBA Loop : Werte suchen und löschen
in Microsoft Excel Hilfe
VBA Loop : Werte suchen und löschen: Hallo zusammen, ich habe folgende Ausgangslage: Im Tabellenblatt Auswahl sollen Artikel eingegeben werden und via Formel wird der zugehörige Lagerplatz ausgegeben (funktioniert soweit), sodass...
Hilfe! Loop ohne Ende ...
in Microsoft Excel Hilfe
Hilfe! Loop ohne Ende ...: Sub FindeProd_Zeilen() Dim c As Range Dim firstAddress As String With Worksheets("Terminverschiebungen").Columns(Spalte_Produktion) Set c =...
Loop / Code soll mehrere Tabellen durchlaufen
in Microsoft Excel Hilfe
Loop / Code soll mehrere Tabellen durchlaufen: Hallo Zusammen Ich wende mich erneut mit einer VBA-Problemstellung an euch. Und zwar habe ich in einer Datei verschiedene Sheets, welche in ihrer Art folgendermassen aufgeteilt und vorhanden...
Bereiche kopieren/einfügen und mittels Loop "automatisieren"
in Microsoft Excel Hilfe
Bereiche kopieren/einfügen und mittels Loop "automatisieren": Hallo liebes MS Office Forum, da ich noch ein VBA Anfänger bin bräuchte ich bitte eure Hilfe *Smilie Zu meinem Problem: Ich möchte im Arbeitsblatt 1 einen definierten Bereich kopieren und in...
Do While Loop Schleife
in Microsoft Access Hilfe
Do While Loop Schleife: Hallo zusammen, ich brauche Unterstützung bei der Entwicklung einer Schleife. In Access habe ich eine Datenbank welche Trainingspläne fürs Schwimmen speichert. Nun soll automatisch ein neuer...

Anmelden oder registrieren

Suche

Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.

Akzeptieren Weitere Informationen...

Information ausblenden