PDA

Vollständige Version anzeigen : Rechnen im Nummernfeld - auch im Endlosformular


Thim Skcalb
30.09.2011, 19:11
Rechnen im Nummernfeld im Formular:

vielleicht mögt auch Ihr einfach in einem Eingabefeld etwas ausrechnen.
z.B. anstatt 77 einfach 11x7 eingeben
mit = oder SPACE nach der Rechnung bleibt man im Feld und kann gleich weiterrechnen, mit TAB und Enter wird ausgerechnet und weitergegangen

Herzliche Grüße vom Schmied

Private Sub Anzahl_KeyDown(KeyCode As Integer, Shift As Integer)
'rechnen in Numerischen Feldern:
Call Berechne(Anzahl, KeyCode) 'hier anstatt Anzahl den Namen des Eingabefeldes angeben
End Sub

Function Berechne(Eingabefeld As Control, KeyCode)
' auf Tastendruck den Wert eines Nummernfeldes ausrechnen in dem eine Rechnung z.B. 3+5*7 eingegeben wird
' für alle von Gabriel Feiner
On Error GoTo Err_Berechne
Dim Eingabefeldtext
Eingabefeldtext = Eingabefeld.text

'rechnen in Numerischen Feldern:
'Bei Taste = oder Space wird der Inhalt berechnet
If KeyCode = vbKeySpace Or KeyCode = 48 Then
Eingabefeld.text = Eval(Replace((Eingabefeldtext), ",", "."))
KeyCode = 0
Eingabefeld.SelStart = Len(Eingabefeldtext)
ElseIf KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
' Bei Taste Enter oder Tab wird berechnet und weitergegangen
Eingabefeld.text = Eval(Replace((Eingabefeldtext), ",", "."))
End If
Exit_Berechne:
Exit Function
Err_Berechne:
MsgBox " diese Berechnung kann ich nicht interpretieren, bitte neu eingeben " & err.Description
Eingabefeld.text = ""
KeyCode = 0
End Function

Thim Skcalb
03.10.2011, 23:40
korrektur - ich hatte den keycode von = falsch geschrieben
und falls sie als tausendertrennung einen punkt verwenden brauchen sie diese funktion

Function Berechne(Eingabefeld As Control, KeyCode)
' auf Tastendruck den Wert neu berechnen
On Error GoTo Err_Berechne
Dim Eingabefeldtext
Eingabefeldtext = Eingabefeld.text

'rechnen in Numerischen Feldern:
'es fehlt noch eine Fehlerabfangroutine für unmögliche Berechnungen!
'Bei Taste = wird der Inhalt berechnet
If KeyCode = 61 Then
Eingabefeld.text = Eval(Replace((Replace((Eingabefeldtext), ".", "")), ",", ".")) 'tausenderpunkt mit nix ersetzen und komma mit punkt ersetzen damit eval funktioniert
KeyCode = 0
Eingabefeld.SelStart = Len(Eingabefeldtext)
ElseIf KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
' Bei Taste Enter oder Tab wird berechnet und weitergegangen
Eingabefeld.text = Eval(Replace((Replace((Eingabefeldtext), ".", "")), ",", ".")) 'tausenderpunkt mit nix ersetzen und komma mit punkt ersetzen damit eval funktioniert

End If
Exit_Berechne:
Exit Function
Err_Berechne:
MsgBox " diese Berechnung kann ich nicht interpretieren, bitte neu eingeben " & err.Description
Eingabefeld.text = ""
KeyCode = 0
End Function

Lanz Rudolf
31.01.2012, 19:30
Hallo
lies einmal hier:
http://www.ms-office-forum.net/forum/showthread.php?t=102899
Darstellung von Code-Abschnitten

Thim Skcalb
31.01.2012, 21:16
Entschuldigt bitte, dass ich oben so schlecht formatiert habe,
es war halt doch das erste mal, dass ich einen Code in das Forum gestellt habe.

Aufruf der Funktion für das Feld EinzelPreis


Private Sub EinzelPreis_KeyDown(KeyCode As Integer, Shift As Integer)
Call Berechne(Einzelpreis, KeyCode)
End Sub


Function Berechne(Eingabefeld As Control, KeyCode)
' auf Tastendruck den Wert neu berechnen
On Error GoTo Err_Berechne
Dim Eingabefeldtext
Eingabefeldtext = Eingabefeld.text
If Eingabefeldtext = "" Then Eingabefeldtext = 0
'wenn mit = beginnt = rauslöschen
If Left(Eingabefeldtext, 1) = "=" Then
Eingabefeldtext = Right(Eingabefeldtext, Len(Eingabefeldtext) - 1)
End If
'rechnen in Numerischen Feldern:

'Bei Taste = wird der Inhalt berechnet
If KeyCode = 61 Or KeyCode = vbKeySpace Then
Eingabefeld.text = Eval(Replace((Replace((Eingabefeldtext), ".", "")), ",", ".")) 'tausenderpunkt mit nix ersetzen und komma mit punkt ersetzen damit eval funktioniert
KeyCode = 0
Eingabefeld.SelStart = Len(Format((Eingabefeldtext), "$#,##0.00"))
'sonderbehandlung für felder welche auf leertaste reagieren sollen
If Eingabefeld.Name = "PreisVerk" Then
KeyCode = vbKeySpace
End If


ElseIf KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
' Bei Taste Enter oder Tab wird berechnet und weitergegangen
Eingabefeld.text = Eval(Replace((Replace((Eingabefeldtext), ".", "")), ",", ".")) 'tausenderpunkt mit nix ersetzen und komma mit punkt ersetzen damit eval funktioniert

End If
Exit_Berechne:
Exit Function
Err_Berechne:
MsgBox " diese Berechnung kann ich nicht interpretieren, bitte neu eingeben " & err.Description
'Sonderbehandlung für Rechnung Nettopreis
If Eingabefeld.Name = "NettoPreis_Textfeld" Then
Eingabefeld.text = "1"
Else
Eingabefeld.text = ""
End If
KeyCode = 0
End Function


vielleicht könnt ihr die Funktion nun brauchen.