Office: (Office 2010) Sub-Prozedur in der Schleife

fredfred · 11. Juni 2020

Warum Shift ?
Jede Taste ein keycode. Ich habe lapidar alles untersagt was größer 67 ist.musst du halt auf die gewünschten z.b. Zahlenblock erweitern.

fredfred · 12. Juni 2020

Wie kommst du auf diese Zeile ???
188 ist das KOmma und hat nix mit Shift zu tun.

Shift ist die Hochstelltaste.

fredfred · 12. Juni 2020

Der Trick besteht doch darin unerwünschte keycodes auf 0 zu setzen, wodurch die Taste irgnoriert wird.

65 ist z.b keycode für das A
If Keycode = 65 then Keyocde =0 würde das A unterdrücken.

gromax · 12. Juni 2020

Hallo Fredfred,

Dein Ansinnen ist mir verständlich und Deine Hinweise kann ich nachvollziehen, aber öffne doch Dein eigenes Beispiel, das Du mir geschickt hast.
Nach der Auswahl einer Schule möchte ich mit dem Ziffernblock den Wert '2,5' eintippen - schon bei der '2' erscheint das rot hinterlegte Feld mit dem Eintrag 'Error'!
Gebe ich den gleichen Wert mit der Tastatur (obere Zahlenreihe) ein, so komme ich bis zu '2,' - die dann folgende '5' generiert wiederum den rot hinterlegten Eintrag 'Error'.
Liege ich denn dabei falsch?

Viele Grüße
gromax

fredfred · 12. Juni 2020

If KeyCode >= 65 Or Shift 188 Then
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

diese Zeile steht nicht bei mir im Code. Sondern
If KeyCode >= 65 And KeyCode 188 Then
188 ist das Komma.

Ich habe meine eigenen DB nochmal runtergeladen, die Eingabe über die Zahlenreihe geht.
Über den Zahlenblock nicht, ist aber auch logisch, weil der Zahlenblock andere keycodes hat die größer als 67 sind.

die 1 auf dem Zahlenblock hat die 97 die 9 die 105.
Diese codes must du halt noch erlauben bzw, die die den Ziffernblock aktiviert. das ist die 144

gromax · 12. Juni 2020

Hallo Fredfred,

ich werde noch zum Hirsch! Sorry!

Nun habe ich folgenden Code:
Code:

Private Sub objClsText_KeyDown(KeyCode As Integer, Shift As Integer)
Dim intShiftDown As Integer, intAltDown As Integer
Dim intCtrlDown As Integer

With objClsText
Select Case KeyCode
Case 144, 48 To 57, 97 To 105, 188

Case Else
KeyCode = 0
.Value = "Error"
.BackColor = vbRed
.ForeColor = vbWhite
.BackStyle = 1

End Select
End With

' Use bit masks to determine which key was pressed.
If intShiftDown = (Shift And acShiftMask) > 0 Then
KeyCode = 0
Shift = 0
End If
If intAltDown = (Shift And acAltMask) > 0 Then
KeyCode = 0
Shift = 0
End If

If intCtrlDown = (Shift And acCtrlMask) > 0 Then
KeyCode = 0
Shift = 0
End If

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

Wo soll ich denn sonstwo noch etwas zulassen? Muss ich denn im Code vom Formular noch eine Eingabe vornehmen? Oder an irgendwelcher anderen Stelle als eben innerhalb des Klassenmoduls. Da habe ich nahezu alles von Deinem Code abgekupfert.

Nachdem ich jetzt die Kommazahl eingegeben habe, erscheint im Code...

Code:

Private Sub objClsText_AfterUpdate()
Dim strSQL As String

Dim db As DAO.Database
Dim rcsDS As DAO.Recordset
Dim strSQLDS As String
Dim intRedArt As Single
Dim i As Integer

Dim rcsRed As DAO.Recordset
Dim strSQLRed As String
Dim strReduktionsart As String

Dim strSQLRedSchule As String
Dim rcsRedSchule As DAO.Recordset

Dim strRedArt() As String 'muss noch redimensioniert werden*

With objClsText
If Nz(.Value, 0) > 0 Then
If .BackColor = RGB(48, 84, 150) Then
.ForeColor = RGB(255, 255, 255)
.BackColor = vbRed
Else
.BackColor = RGB(48, 84, 150)
.ForeColor = RGB(255, 255, 255)
End If
Else
.BackColor = vbWhite
End If

If DCount("*", "Tbl_Minderungen", "MIND_SCH_FS =" & lngSchule _
& " AND MIND_REDART_FS =" & .Tag) = 0 Then

i = lngSchule
'Neuer DS
If objClsText.Value = 0 Then
objClsText.Value = ""
Exit Sub
End If

strSQL = "INSERT into Tbl_Minderungen (MIND_SCH_FS, MIND_REDART_FS, MIND_LWH, MIND_VON, MIND_BIS) " & _
"VALUES (" & lngSchule & "," & .Tag & ", " & .Value & _
", FirstSchDay(date()), LastSchDay(Date()) );"

Else

i = lngSchule

'Updaten oder löschen MIND_SCH_FS (Schule), MIND_REDART_FS (Art), MIND_LWH (Wert), MIND_VON, MIND_BIS

If Nz(.Value, 0) = 0 Then
strSQL = "DELETE * FROM Tbl_Minderungen WHERE MIND_SCH_FS =" & lngSchule _
& " AND MIND_REDART_FS =" & .Tag
Else
strSQL = "UPDATE Tbl_Minderungen SET MIND_SCH_FS = " & lngSchule & _
", MIND_REDART_FS =" & .Tag & ", MIND_LWH = " & Nz(.Value, Null) & _
", MIND_von = FirstSchDay(date()),MIND_bis =LastSchDay(Date()) " & _
" WHERE MIND_SCH_FS=" & lngSchule & " AND MIND_REDART_FS= " & .Tag & ";"
End If
End If

CurrentDb.Execute strSQL, 128
End With

'>>>>>>>>>>>>>>>>>>>>Einlesen der Schul-Reduktionen im Hauptformular
Set db = CurrentDb
strSQLRedSchule = "SELECT Sum(MIND_Lwh) FROM qry_ReduktionenAbgleich01 WHERE SCH_PS = " & i
Set rcsRedSchule = db.OpenRecordset(strSQLRedSchule, dbOpenDynaset)
rcsRedSchule.MoveLast
If rcsRedSchule.EOF Then
Forms!frm_SchulenGesamt!txtRed = 0
Else
Forms!frm_SchulenGesamt!txtRed = Nz(rcsRedSchule(0).Value, 0)
Forms!frm_SchulenGesamt!txtLIstSumme = Forms!frm_SchulenGesamt!txtSumEinLwh - Forms!frm_SchulenGesamt!txtRed
Forms!frm_SchulenGesamt!txtSaldoSchule = Forms!frm_SchulenGesamt!txtLIstSumme - Forms!frm_SchulenGesamt!txtUSollSumme
End If
rcsRedSchule.Close
Set rcsRedSchule = Nothing

Set db = Nothing

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

...in der Zeile CurrentDb.Execute strSQL, 128 der Laufzeitfehler '3144' - Syntaxfehler in der UPDATE-Anweisung!

Ist es relevant, dass mein Formular ein Registersteuerelement ist? Der Aufruf der Schule findet im dortigen Hauptformular statt, also nicht wie im Beispiel, das ich Dir zugesandt habe. Dieses musste ich reduzieren, sonst wäre der Versand zu groß geworden!

Unglaublich, dass ich das nicht hinbekomme!!

Viele Grüße
gromax

fredfred · 12. Juni 2020

die wichtigste Information hast du überlesen.

#14 Verwende Double und kein Single. Ein Dezimalwert muss im String über die Str() Funktion geparst werden.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Entscheidend ist die str() Funktion...
Str() wandelt das Komma in einen Punkt und bereitet so den Dezimalwert für den SQL-String vor.

Die Amerikaner verwenden den "." als Komma.

Ob das auf einem Register steht, ist vollkommen wurscht.

gromax · 12. Juni 2020

Hallo Fredfred,

ich habe jetzt den SQL-Code von Dir mit einem Recordset-Konstrukt ersetzt und siehe da - es klappt! Was bin ich froh!!

Mein Code:
Code:

Private Sub objClsText_AfterUpdate()
Dim strSQL As String

Dim db As DAO.Database
Dim rcsDS As DAO.Recordset
Dim strSQLDS As String
Dim intRedArt As Single
Dim i As Integer

Dim rcsRed As DAO.Recordset
Dim strSQLRed As String
Dim intReduktionsart As Integer

Dim strSQLRedSchule As String
Dim rcsRedSchule As DAO.Recordset

Dim strRedArt() As String 'muss noch redimensioniert werden*

Set db = CurrentDb

With objClsText
If Nz(.Value, 0) > 0 Then
If .BackColor = RGB(48, 84, 150) Then
.ForeColor = RGB(255, 255, 255)
.BackColor = vbRed
Else
.BackColor = RGB(48, 84, 150)
.ForeColor = RGB(255, 255, 255)
End If
Else
.BackColor = vbWhite
End If

strSQLRed = "SELECT * FROM tbl_MINDERUNGEN WHERE MIND_SCH_FS = " & lngSchule & " And MIND_REDART_FS = " & .Tag
Set rcsRed = db.OpenRecordset(strSQLRed, dbOpenDynaset)
intReduktionsart = .Tag

If rcsRed.EOF Then

With rcsRed
.AddNew
.Fields(1).Value = lngSchule
.Fields(2).Value = intReduktionsart
.Fields(3).Value = FirstSchDay(Date)
.Fields(4).Value = LastSchDay(Date)
.Fields(5).Value = Nz(objClsText.Value, Null)
.Update
.Close
End With

Else
With rcsRed
.Edit
.Fields(5).Value = Nz(objClsText.Value, Null)
.Update
.Close
End With
End If

End With

'>>>>>>>>>>>>>>>>>>>>Einlesen der Schul-Reduktionen im Hauptformular
strSQLRedSchule = "SELECT Sum(MIND_Lwh) FROM qry_ReduktionenAbgleich01 WHERE SCH_PS = " & lngSchule
Set rcsRedSchule = db.OpenRecordset(strSQLRedSchule, dbOpenDynaset)
rcsRedSchule.MoveLast

If rcsRedSchule.EOF Then
Forms!frm_SchulenGesamt!txtRed = 0
Else
Forms!frm_SchulenGesamt!txtRed = Nz(rcsRedSchule(0).Value, 0)
Forms!frm_SchulenGesamt!txtLIstSumme = Forms!frm_SchulenGesamt!txtSumEinLwh - Forms!frm_SchulenGesamt!txtRed
Forms!frm_SchulenGesamt!txtSaldoSchule = Forms!frm_SchulenGesamt!txtLIstSumme - Forms!frm_SchulenGesamt!txtUSollSumme
End If

rcsRedSchule.Close
Set rcsRedSchule = Nothing
Set rcsRed = Nothing

Set db = Nothing

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

Das ist sicherlich nicht professionell, dennoch würde mich Deine Meinung dazu interessieren.

Ohne Dich wäre ich nie zu dieser Lösung gekommen, ich hätte wahrscheinlich für jedes der 72 Textfelder den analogen Code eingegeben!?

Zu Deinem Hinweis:
Den Zahlentyp Double habe ich schon entsprechend definiert, aber was Du mit "parsen" meinst und wo man dieses macht, weiß ich nicht!

Trotzdem wäre ich froh, wenn Du Deinen Kommentar noch anhängst.

Vielen, vielen Dank - auch für Deine Dauerhaftigkeit der Unterstützung.

Alles Gute
gromax

fredfred · 12. Juni 2020

Unschöne Lösung mit dem Recordset.

Du musst doch lediglich um

.value -> der Wert in der Textbox ein str() setzen

Das ist doch im Upload so auch drin!
------"VALUES (" & lngSchule & "," & .Tag & ", " & Str(.Value) & _

---MIND_LWH = " & Str(.Value) & _

Auch dein Nachtrag mit den Forms-Bezügen gefällt mir nicht.
Auch das ganze recordset-GEblubbere um die Gesamtsumme zu erhalten, lässt sich mit einer DSum() Zeile erschlagen.

gromax · 13. Juni 2020

Hallo Fredfred,

Deine Hinweise habe ich umgesetzt und es klappt.

Dass Du die Recordset-Konstruktionen nicht favorisierst, überrascht mich. Diese funktionieren doch echt schnell und sind auch im Nachvollzug "leicht lesbar"; auch habe ich irgendwo gelesen, dass die Dom-Funktionen zu langsam wären und dass ihnen ein Recordset vorzuziehen wäre! Wie auch immer.

Ich bin froh, dass das Formular jetzt läuft - vielen aufrichtigen Dank!

Viele Grüße
und bleib gesund!
gromax

fredfred · 14. Juni 2020

Präferenz in der Reihenfolge:
SQL
VBA
D-Funktionen

Da es hier aber um einen einzigen Wert geht, spielt das überhaupt keine Rolle. Insofern ziehe ich die kurze einzeilige D-Funktion dem ganzen RS-Gedöns vor.
Statt dem SQL könnte man sicherlich auch zu einer RS-Version übergehen, mir persönlich erscheint der SQL-Code übersichtlicher und leicht überschaubar.

Eine fixe Referenz auf ein Formular in einer Klasse zu setzen, halte ich für sehr fragwürdig. Gegebenfalls sollte man der Klasse die Form-Instanz übergeben, aber keinesfalls darin fixieren. Damit werden unnötige Abhängigkeiten geschaffen.
Soviel zu deiner Erweiterung die Gesamtanzahl aufs Formular zu bringen.

Office: (Office 2010) Sub-Prozedur in der Schleife

Sub-Prozedur in der Schleife

Sub-Prozedur in der Schleife

Sub-Prozedur in der Schleife

Sub-Prozedur in der Schleife

Sub-Prozedur in der Schleife - Similar Threads - Sub Prozedur Schleife

"Eigene"excel-Funktion innerhalb einer Sub verwenden

Problem mit Private Sub Worksheet_Change

Listenfeld in Word 2016

Function Sub und Makro

VBA Spalten aus- und einblenden trotz Blattschutz

Aufruf private sub prozedur

Aufruf von Sub im Modul funktioniert nicht