Zum Inhalt springen

Empfohlene Beiträge

Geschrieben

Hi

Folgendes Problem.

Das Prog funktioniert einwandfrei bis auf einen Fehler:

Wenn man die Optionfelder auf Jahre stellt und in das Combo Feld eine Zahl ab 9000 aufwärts eingibt wird die MsgBox ( Fehlermeldung) aktiviert und scheint einer unendlich Schleife gleich.

Was kann das sein oder was habe ich Falsch gemacht.....

bild.png

Option Explicit

'Pfadangaben Konstanten

Const OPERATION_PLUSBILD_PFAD = "C:\Dokumente und Einstellungen\ich\Eigene Dateien\plus.wmf"

Const OPERATION_MINUSBILD_PFAD = "C:\Dokumente und Einstellungen\ich\Eigene Dateien\minus.wmf"


'Eingabe der Min und Max mit Infotext

Const DIFFERENZ_MIN = 1

Const DIFFERENZ_MAX = 9999

Const DIFFERENZ_INFOTEXT = "Geben Sie eine Zahl zwischen " & DIFFERENZ_MIN & _

 " und " & DIFFERENZ_MAX & " ein."

 Private Sub cboDifferenz_Change()

'Für die reibunglose Sofortrechnung muss dies sein

txtDatum_Change

End Sub


Private Sub cboDifferenz_Click()

'Für die reibunglose Sofortrechnung muss dies sein

txtDatum_Change

End Sub


Private Sub chkRechneSofort_Click()

' Wenn Checkbox Enebled ( Haken ) dann gleiche bedeutung wie Button Rechnen

cmdRechnen.Enabled = chkRechneSofort.Value <> vbChecked

txtDatum_Change


End Sub


Private Sub cmdEnde_Click()

End


End Sub


Private Sub cmdRechnen_Click()

'Variabledeklaration addieren und subtrahieren

Dim nDifferenz As Integer

Dim sDiffEinheit As String


'Zur Unterdrückung des Laufzeitfehlers

On Error GoTo DIFFERENZ_INFOTEXT

'Variablewert

nDifferenz = cboDifferenz.Text

'If Anweisung

If lstOperation.ListIndex = 1 Then

nDifferenz = nDifferenz * -1

End If


[COLOR="Red"]'Optionsfelder Prozedur

sDiffEinheit = "d"

If optDiffEinheit(1).Value Then

sDiffEinheit = "m"

[COLOR="Blue"]ElseIf optDiffEinheit(2).Value Then

sDiffEinheit = "YYYY"[/COLOR]End If[/COLOR]


'Laden der Grafiken bei Plus das Pluszeichen und Minus......

If nDifferenz <= 0 Then

imgAnzeige.Picture = LoadPicture(OPERATION_MINUSBILD_PFAD)

Else

imgAnzeige.Picture = LoadPicture(OPERATION_PLUSBILD_PFAD)

End If


'Ausgabe der Berechnung

lblAnzeige.Caption = DateAdd(sDiffEinheit, nDifferenz, txtDatum.Text)

Exit Sub

DIFFERENZ_INFOTEXT:

Beep

MsgBox DIFFERENZ_INFOTEXT

cboDifferenz.Text = DIFFERENZ_MIN

cboDifferenz.SetFocus

cboDifferenz.SelStart = 0

cboDifferenz.SelLength = Len(cboDifferenz.Text)

Resume


End Sub



Private Sub Form_Load()



'das heutige datum ausgeben

lblDatumHeute = Date


' Füllen des Listenfeldes

lstOperation.AddItem "addieren"

lstOperation.AddItem "subtrahieren"

' 0 = Listenfeld 1 ; 1 = Listenfeld 2 usw......

lstOperation.ListIndex = 0


'Füllen des Combolistenfeld

cboDifferenz.AddItem "10"

cboDifferenz.AddItem "100"

cboDifferenz.AddItem "1000"

cboDifferenz.ToolTipText = DIFFERENZ_INFOTEXT

End Sub



Private Sub imgAnzeige_Click()

'Zum Umschalten der Listebox

lstOperation.ListIndex = (lstOperation.ListIndex + 1) Mod 2

End Sub





Private Sub lstOperation_Click()

'Damit es bei eingestellten Haken addieren und subtrahieren funktioniert

'Vorteil: Ohne Umleitung müßte man Änderungen in allen Ereignisprozeduren

'vornehmen , die eine Umleitung auf die methode txtDatum_Change enthalten

txtDatum_Change

End Sub


Private Sub optDiffEinheit_Click(Index As Integer)

'Umleitung

txtDatum_Change

End Sub



Private Sub txtDatum_Change()

'Eingabe Textfeld

If chkRechneSofort.Value = vbChecked Then

cmdRechnen_Click

End If


End Sub

Habe im Code den meiner Meinung nach der Fehler besteht mit rotem Text markiert und Blau das von Jahre.....

danke für die Hilfe

Geschrieben

DIFFERENZ_INFOTEXT:

Beep

MsgBox DIFFERENZ_INFOTEXT

Combo1.Text = DIFFERENZ_MIN

Combo1.SetFocus

Combo1.SelStart = 0

Combo1.SelLength = Len(Combo1.Text)

Resume

wenn du schon einen fehler abarbeitest, dann solltest du danach aus der funktion gehn und nicht resume machen...

entferne einfach das resume

Geschrieben

Wenn ich On Error... rausnehme und es laufen lasse ist der Fehler in der Zeile:

lblAnzeige.Caption = DateAdd(sDiffEinheit, nDifferenz, txtDatum.Text)

Nur ich komme nicht darauf denn Monate und Tage funktionieren und Jahre net...

ab 9000 Spinnt er dann.....

Geschrieben

naja da gibts wohl nen VB überlauf im datum... man kann eben nicht mehr als 9000 jahre in die zukunft rechnen

habs grad auch versucht mit:

das = DateAdd("YYYY", 7000, "01.01.1990")

geht...

das = DateAdd("YYYY", 9000, "01.01.1990")

geht nicht...

das = DateAdd("YYYY", 9000, "01.01.990")

geht...

wird wohl daran liegen dass nur 4 zeichen für das jahr reserviert/möglich sind ;)

Geschrieben

Also einzige Lösung Const runterschrauben auf 7000 und jut is......

ABER:

wenn einer das Datum 01.01.2200 eintippt habe ich das Problem auch mit 7000 oder?

Wenn ich Minus rechnen lasse ist es auch Falsch.

Wie dus machst is ja dann falsch....

Gibt es keine Möglichkeit das Datum in 5 Stellen zu erweitern?

Danke

Geschrieben

Alles klar

Werde es in die Const DIFFERENZ_INFOTEXT als ausgabe vermerken das es in Jahre in solch eine Summe nicht Möglich ist vorrauszurechnen.In Monate und Tage funktioniert es ja.....

Ein Dankeschön an euch

Geschrieben

Ein wenig in Bücher geschnüffelt und auf diese Lösung gekommen....:

Private Sub cboDifferenz_Change()

'--aktuelle gültigkeit Differenzwert prüfen evtl. korregieren

'--..und anschliesend in statischer Variable merken


Static nDiffAlt As Integer

Dim nDiffKorr As Integer


'Statische variable beim ersten aufruf auf Minimum setzen

If nDiffAlt = 0 Then

nDiffAlt = DIFFERENZ_MIN

End If


'Wert kontrollieren Testen evtl.Laufzeitfehler provozieren

On Error Resume Next

nDiffKorr = cboDifferenz.Text

If Err <> 0 Then

'Laufzeitfehler durch Fehlerhaften Wert

'....Eingabe zurücknehmen und nachher Fehler mit Beep melden

nDiffKorr = nDiffAlt

Else

Select Case CInt(cboDifferenz.Text)

Case Is > DIFFERENZ_MAX

'auf Maximalwert begrenzen

nDiffKorr = DIFFERENZ_MAX

Case Is < DIFFERENZ_MIN

'Minimalwert garantieren

nDiffKorr = DIFFERENZ_MIN

Case Else

'kein Laufzeit - und Überlauf-Fehler

If IsNumeric(cboDifferenz.Text) Then

'und keine Eingabefehler, dann nDiffKorr für Fehlererkennung auf Null setzen

nDiffKorr = 0

End If

End Select

End If

On Error GoTo 0

'Korektur durchfürhern und Fehler Melden

If nDiffKorr <> 0 Then

Beep

cboDifferenz.Text = nDiffKorr

cboDifferenz.SetFocus

cboDifferenz.SelStart = 0

cboDifferenz.SelLength = Len(cboDifferenz.Text)

End If


' (evtl.korregieren ) Wert merken für nächste Change-Ergebnis

nDiffAlt = cboDifferenz.Text

'evtl. Sofort Berechnung durchführen

txtDatum_Change

End Sub

Somit kann man erst gar nicht auf das hoh datum kommen und Buchstaben sind auch nicht erlaubt....

gruß

Dein Kommentar

Du kannst jetzt schreiben und Dich später registrieren. Wenn Du ein Konto hast, melde Dich jetzt an, um unter Deinem Benutzernamen zu schreiben.

Gast
Auf dieses Thema antworten...

×   Du hast formatierten Text eingefügt.   Formatierung wiederherstellen

  Nur 75 Emojis sind erlaubt.

×   Dein Link wurde automatisch eingebettet.   Einbetten rückgängig machen und als Link darstellen

×   Dein vorheriger Inhalt wurde wiederhergestellt.   Editor leeren

×   Du kannst Bilder nicht direkt einfügen. Lade Bilder hoch oder lade sie von einer URL.

Fachinformatiker.de, 2024 by SE Internet Services

fidelogo_small.png

Schicke uns eine Nachricht!

Fachinformatiker.de ist die größte IT-Community
rund um Ausbildung, Job, Weiterbildung für IT-Fachkräfte.

Fachinformatiker.de App

Download on the App Store
Get it on Google Play

Kontakt

Hier werben?
Oder sende eine E-Mail an

Social media u. feeds

Jobboard für Fachinformatiker und IT-Fachkräfte

×
×
  • Neu erstellen...