Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Re: Dauerhafte Abfrage oder Überprüfung?
Autor: Toca
Datum: 22.11.01 11:48
Ohje, Ohje, bitte habNachsicht mit mir. Der Code sieht mit Sicherheit schrecklich aus für euch. Aber vielleicht kannst du mir ja dazu noch ein paar Tipps geben. Bin nämlich erst seit letzter Woche mit 4 Büchern und diesem Forum dabei, Programme in VB6 zu schreiben. ____________________________________________________________________ Option Explicit Public Gerät As Single Public Feuchte As Double Public Bodenart As Double Public FF As Double Dim Gesamt As Double Public EIGENFF As Double LblMiwert1.Visible = False LblMiwert2.Visible = False lblMiwert3.Visible = False If Bodenklasse = 1 And Gesamt = 20001 Then FF = 1.2 ElseIf Bodenklasse = 1 And Gesamt = 20002 Then FF = 1 ElseIf Bodenklasse = 1 And Gesamt = 20002 Then FF = 1.1 ElseIf Bodenklasse = 1 And Gesamt = 20002 Then FF = 1.07 ElseIf Bodenklasse = 1 And Gesamt = 20103 Then FF = 1# ElseIf Bodenklasse = 1 And Gesamt = 20203 Then FF = 1.1 ElseIf Bodenklasse = 1 And Gesamt = 20303 Then FF = 1.07 ElseIf Bodenklasse = 1 And Gesamt = 20102 Then FF = 0.9 ElseIf Bodenklasse = 1 And Gesamt = 20202 Then FF = 1 ElseIf Bodenklasse = 1 And Gesamt = 20302 Then FF = 1 ElseIf Bodenklasse = 1 And Gesamt = 20004 Then FF = 1 ElseIf Bodenklasse = 1 And Gesamt = 20005 Then FF = 1.2 ElseIf Bodenklasse = 1 And Gesamt = 20106 Then FF = 1 ElseIf Bodenklasse = 1 And Gesamt = 20206 Then FF = 1.1 ElseIf Bodenklasse = 1 And Gesamt = 20306 Then FF = 1.1 '************************************************************** '***********************BKL 3********************************** '************************************************************** ' **********************Bagger ElseIf Bodenklasse = 3 And Gesamt = 1001 Then FF = 1.13 ElseIf Bodenklasse = 3 And Gesamt = 2001 Then FF = 1.13 ElseIf Bodenklasse = 3 And Gesamt = 3001 Then FF = 1.13 ElseIf Bodenklasse = 3 And Gesamt = 4001 Then 'MsgBox Prompt:="Keine Daten für schnittfesten Torf oder Mudden verfügbar" & vbCrLf & "Bitte neue Auswahl treffen" DlgEigenfüll.Show ' ***********************Radlader ElseIf Bodenklasse = 3 And Gesamt = 1102 Then FF = 0.73 ElseIf Bodenklasse = 3 And Gesamt = 1202 Then FF = 0.86 ElseIf Bodenklasse = 3 And Gesamt = 1302 Then FF = 0.86 ElseIf Bodenklasse = 3 And Gesamt = 2102 Then FF = 0.77 ElseIf Bodenklasse = 3 And Gesamt = 2202 Then FF = 0.87 ElseIf Bodenklasse = 3 And Gesamt = 1202 Then FF = 0.86 ElseIf Bodenklasse = 3 And Gesamt = 1302 Then FF = 0.86 ElseIf Bodenklasse = 3 And Gesamt = 2302 Then FF = 0.87 ElseIf Bodenklasse = 3 And Gesamt = 3102 Then FF = 0.91 ElseIf Bodenklasse = 3 And Gesamt = 3202 Then FF = 0.97 ElseIf Bodenklasse = 3 And Gesamt = 3302 Then FF = 0.95 ElseIf Bodenklasse = 3 And Gesamt = 4102 Then 'MsgBox Prompt:="Keine Daten für schnittfesten Torf oder Mudden verfügbar" & vbCrLf & "Bitte neue Auswahl treffen" DlgEigenfüll.Show ElseIf Bodenklasse = 3 And Gesamt = 4202 Then 'MsgBox Prompt:="Keine Daten für schnittfesten Torf oder Mudden verfügbar" & vbCrLf & "Bitte neue Auswahl treffen" DlgEigenfüll.Show ElseIf Bodenklasse = 3 And Gesamt = 4302 Then 'MsgBox Prompt:="Keine Daten für schnittfesten Torf oder Mudden verfügbar" & vbCrLf & "Bitte neue Auswahl treffen" DlgEigenfüll.Show '************************************************* '********************BKL 4************************ '************************************************* ElseIf Bodenklasse = 4 And Gesamt = 1001 Then FF = 1.2 ElseIf Bodenklasse = 4 And Gesamt = 2001 Then FF = 1.2 ' ***********************Radlader ElseIf Bodenklasse = 4 And Gesamt = 1102 Then FF = 0.9 ElseIf Bodenklasse = 4 And Gesamt = 1202 Then FF = 0.98 ElseIf Bodenklasse = 4 And Gesamt = 2202 Then FF = 0.93 ElseIf Bodenklasse = 4 And Gesamt = 1302 Then FF = 1.02 ElseIf Bodenklasse = 4 And Gesamt = 2302 Then FF = 0.99 ElseIf Bodenklasse = 4 And Gesamt = 2102 Then 'MsgBox Prompt:="Keine Daten für Mergel, Schutt, Lehm verfügbar" & vbCrLf & "Bitte neue Auswahl treffen" DlgEigenfüll.Show ElseIf Bodenklasse = 4 And Gesamt = 4202 Then 'MsgBox Prompt:="Keine Daten für Mergel, Schutt, Lehm verfügbar" & vbCrLf & "Bitte neue Auswahl treffen" DlgEigenfüll.Show ElseIf Bodenklasse = 4 And Gesamt = 4302 Then 'MsgBox Prompt:="Keine Daten für Mergel, Schutt, Lehm verfügbar" & vbCrLf & "Bitte neue Auswahl treffen" DlgEigenfüll.Show ''************************************************* '********************BKL 5************************ '************************************************* ElseIf Bodenklasse = 5 And Gesamt = 1001 Then FF = 1.15 ElseIf Bodenklasse = 5 And Gesamt = 2001 Then FF = 1.15 ' ***********************Radlader ElseIf Bodenklasse = 5 And Gesamt = 1102 Then FF = 0.87 ElseIf Bodenklasse = 5 And Gesamt = 1202 Then FF = 0.87 ElseIf Bodenklasse = 5 And Gesamt = 2202 Then FF = 0.89 ElseIf Bodenklasse = 5 And Gesamt = 1302 Then 'MsgBox Prompt:="Keine Daten für Gesteinsschotter verfügbar" & vbCrLf & "Bitte neue Auswahl treffen" DlgEigenfüll.Show ElseIf Bodenklasse = 5 And Gesamt = 2302 Then FF = 0.89 ElseIf Bodenklasse = 5 And Gesamt = 2102 Then 'MsgBox Prompt:="Keine Daten für fest zusammenhängende Böden verfügbar" & vbCrLf & "Bitte neue Auswahl treffen" DlgEigenfüll.Show ElseIf Bodenklasse = 5 And Gesamt = 4302 Then 'MsgBox Prompt:="Keine Daten für fest zusammenhängende Böden verfügbar" & vbCrLf & "Bitte neue Auswahl treffen" DlgEigenfüll.Show ElseIf Bodenklasse = 5 And Gesamt = 4302 Then 'MsgBox Prompt:="Keine Daten für fest zusammenhängende Böden verfügbar" & vbCrLf & "Bitte neue Auswahl treffen" DlgEigenfüll.Show ''************************************************* '********************BKL 6************************ '************************************************* ElseIf Bodenklasse = 6 And Gesamt = 1001 Then FF = 0.95 ElseIf Bodenklasse = 6 And Gesamt = 2001 Then FF = 0.92 ' ***********************Radlader ElseIf Bodenklasse = 6 And Gesamt = 1102 Then FF = 0.8 ElseIf Bodenklasse = 6 And Gesamt = 1202 Then FF = 0.8 ElseIf Bodenklasse = 6 And Gesamt = 1302 Then FF = 0.8 ElseIf Bodenklasse = 6 And Gesamt = 2202 Then FF = 0.72 ElseIf Bodenklasse = 6 And Gesamt = 2302 Then FF = 0.72 ElseIf Bodenklasse = 6 And Gesamt = 2102 Then FF = 0.72 'ElseIf Bodenklasse = 6 And Gesamt = 2102 Or 2202 Or 2302 Then 'FF = 0.72 Private Sub cmdEFFAbr_Click() lblWarnEigenFF.Visible = False txtEigenFF.Visible = False cmdEFFÜber.Visible = False cmdEFFAbr.Visible = False FF = 0 txtEigenFF.Text = "" Label10.Caption = FF Label9.Caption = FF Command3.Visible = False cmdEigenFF.Visible = True cmdWeiter.Enabled = False CmdBerechnen.Visible = True End Sub Private Sub cmdEFFÜber_Click() FF = 0 If IsNumeric(txtEigenFF.Text) = True Then FF = txtEigenFF.Text Label10.Caption = FF Gesamt = 50000 Label8.Caption = Gesamt If FF = 0 Then cmdWeiter.Enabled = False Else: cmdWeiter.Enabled = True End If Exit Sub ElseIf IsNumeric(txtEigenFF.Text) = False Then MsgBox Prompt:="Bitte geben Sie einen gültigen Zahlenwert ein!" Exit Sub End If End Sub Private Sub cmdEigenFF_Click() lblWarnEigenFF.Visible = True txtEigenFF.Visible = True cmdEFFÜber.Visible = True cmdEFFAbr.Visible = True txtEigenFF.SetFocus CmdBerechnen.Visible = False cmdEigenFF.Visible = False Command3.Visible = True cmdWeiter.Enabled = False End Sub Private Sub cmdWeiter_Click() Label10.Caption = FF If Gerät = 0 Then MsgBox Prompt:="Wählen Sie ein Gerät aus" ElseIf Gerät = 1 Then Unload Me frmHydraulikbagger.Show End If End Sub Private Sub Command1_Click() Unload Me frmZUFA.Show End Sub Private Sub Command2_Click() Unload Me frmErdbauhaupt.Show End Sub Private Sub Command3_Click() lblWarnEigenFF.Visible = False txtEigenFF.Visible = False cmdEFFÜber.Visible = False cmdEFFAbr.Visible = False 'txtEigenFF.SetFocus CmdBerechnen.Visible = True cmdEigenFF.Visible = True Command3.Visible = False cmdWeiter.Enabled = False End Sub Private Sub Form_Load() LblBKL.Caption = frmZUFA.Bodenklasse Bodenklasse = frmZUFA.Bodenklasse Label4.Caption = Gerät If Bodenklasse = 1 Then OptBA1.Enabled = False OptBA2.Enabled = False OptBA3.Enabled = False OptBA4.Enabled = False ElseIf Bodenklasse = 3 Then OptBA1.Enabled = True OptBA2.Enabled = True OptBA3.Enabled = True OptBA4.Enabled = True ElseIf Bodenklasse > 3 Then OptBA1.Enabled = True OptBA2.Enabled = True OptBA3.Enabled = False OptBA4.Enabled = False End If If Bodenklasse = 1 Then LblKEUNT.Visible = True ElseIf Bodenklasse = 3 Then LblBKL3a.Visible = True lblBKl3b.Visible = True lblBKL3c.Visible = True lblBKL3d.Visible = True ElseIf Bodenklasse = 4 Then lblBKL4a.Visible = True lblBKL4b.Visible = True ElseIf Bodenklasse = 5 Then lblBKL5a.Visible = True lblBKL5b.Visible = True ElseIf Bodenklasse = 6 Then lblBKL6a.Visible = True lblBKL6b.Visible = True End If Feuchte = 10000 Gerät = 0 Bodenart = 20000 Label5.Caption = Bodenart Label4.Caption = Gerät Label6.Caption = Feuchte End Sub Private Sub OptBA1_Click() FF = 0 Bodenart = 1000 If Bodenklasse = 1 Then Bodenart = 0 End If Label5.Caption = Bodenart Gesamt = Gerät + Feuchte + Bodenart Label8.Caption = Gesamt cmdWeiter.Enabled = False End Sub Private Sub OptBA2_Click() FF = 0 Bodenart = 2000 If Bodenklasse = 1 Then Bodenart = 0 End If Label5.Caption = Bodenart Gesamt = Gerät + Feuchte + Bodenart Label8.Caption = Gesamt cmdWeiter.Enabled = False End Sub Private Sub OptBA3_Click() FF = 0 Bodenart = 3000 If Bodenklasse = 1 Then Bodenart = 0 ElseIf Bodenklasse > 3 Then Bodenart = 0 End If Label5.Caption = Bodenart Gesamt = Gerät + Feuchte + Bodenart Label8.Caption = Gesamt cmdWeiter.Enabled = False End Sub Private Sub OptBA4_Click() FF = 0 Bodenart = 4000 If Bodenklasse = 1 Then Bodenart = 0 ElseIf Bodenklasse > 3 Then Bodenart = 0 End If Label5.Caption = Bodenart Gesamt = Gerät + Feuchte + Bodenart Label8.Caption = Gesamt cmdWeiter.Enabled = False End Sub ' AUSWAHL FEUCHTE Private Sub Opttrocken_Click() FF = 0 Feuchte = 100 If Gerät = 1 Then Feuchte = 0 ElseIf Gerät = 4 Then Feuchte = 0 ElseIf Gerät = 5 Then Gerät = 0 End If Label6.Caption = Feuchte Gesamt = Gerät + Feuchte + Bodenart Label8.Caption = Gesamt cmdWeiter.Enabled = False End Sub ' AUSWAHL FEUCHTE Private Sub Opterdfeucht_Click() FF = 0 Feuchte = 200 If Gerät = 1 Then Feuchte = 0 ElseIf Gerät = 4 Then Feuchte = 0 ElseIf Gerät = 5 Then Gerät = 0 End If Label6.Caption = Feuchte Gesamt = Gerät + Feuchte + Bodenart Label8.Caption = Gesamt cmdWeiter.Enabled = False End Sub ' AUSWAHL FEUCHTE Private Sub Optnass_Click() FF = 0 Feuchte = 300 If Gerät = 1 Then Feuchte = 0 ElseIf Gerät = 4 Then Feuchte = 0 ElseIf Gerät = 5 Then Gerät = 0 End If Label6.Caption = Feuchte Gesamt = Gerät + Feuchte + Bodenart Label8.Caption = Gesamt cmdWeiter.Enabled = False End Sub ' AUSWAHL Gerät Hydraulikbagger Private Sub Opthydbag_Click() FF = 0 'txtEigenFF.Visible = False 'lblWarnEigenFF.Visible = False Gerät = 1 Opttrocken.Enabled = False Optnass.Enabled = False Opterdfeucht.Enabled = False If Bodenklasse = 1 Then LblKEUNT.Visible = True ElseIf Bodenklasse = 3 Then LblBKL3a.Visible = True lblBKl3b.Visible = True lblBKL3c.Visible = True lblBKL3d.Visible = True lblBKL3d.Enabled = False ElseIf Bodenklasse = 4 Then lblBKL4a.Visible = True lblBKL4b.Visible = True ElseIf Bodenklasse = 5 Then lblBKL5a.Visible = True lblBKL5b.Visible = True ElseIf Bodenklasse = 6 Then lblBKL6a.Visible = True lblBKL6b.Visible = True End If Label4.Caption = Gerät If Bodenklasse = 1 Then OptBA1.Enabled = False OptBA2.Enabled = False OptBA3.Enabled = False OptBA4.Enabled = False ElseIf Bodenklasse = 3 Then OptBA1.Enabled = True OptBA2.Enabled = True OptBA3.Enabled = True OptBA4.Enabled = True ElseIf Bodenklasse > 3 Then OptBA1.Enabled = True OptBA2.Enabled = True OptBA3.Enabled = False OptBA4.Enabled = False End If Feuchte = 0 Label6.Caption = Feuchte Gesamt = Gerät + Feuchte + Bodenart Label8.Caption = Gesamt cmdWeiter.Enabled = False End Sub ' AUSWAHL Gerät Radlader Private Sub OptRadlader_Click() FF = 0 'txtEigenFF.Visible = False 'lblWarnEigenFF.Visible = False Gerät = 2 Opttrocken.Enabled = True Optnass.Enabled = True Opterdfeucht.Enabled = True If Bodenklasse = 1 Then LblKEUNT.Visible = True ElseIf Bodenklasse = 3 Then LblBKL3a.Visible = True lblBKl3b.Visible = True lblBKL3c.Visible = True lblBKL3d.Visible = True lblBKL3d.Enabled = True ElseIf Bodenklasse = 4 Then lblBKL4a.Visible = True lblBKL4b.Visible = True ElseIf Bodenklasse = 5 Then lblBKL5a.Visible = True lblBKL5b.Visible = True ElseIf Bodenklasse = 6 Then lblBKL6a.Visible = True lblBKL6b.Visible = True End If Label4.Caption = Gerät If Bodenklasse = 1 Then OptBA1.Enabled = False OptBA2.Enabled = False OptBA3.Enabled = False OptBA4.Enabled = False ElseIf Bodenklasse = 3 Then OptBA1.Enabled = True OptBA2.Enabled = True OptBA3.Enabled = True OptBA4.Enabled = True ElseIf Bodenklasse > 3 Then OptBA1.Enabled = True OptBA2.Enabled = True OptBA3.Enabled = False OptBA4.Enabled = False End If If Optnass.Value = True Then Feuchte = 300 ElseIf Opterdfeucht.Value = True Then Feuchte = 200 ElseIf Opttrocken.Value = True Then Feuchte = 100 End If Label6.Caption = Feuchte Gesamt = Gerät + Feuchte + Bodenart Label8.Caption = Gesamt cmdWeiter.Enabled = False End Sub

Dauerhafte Abfrage oder Überprüfung?	51	Toca	22.11.01 10:48
Re: Dauerhafte Abfrage oder Überprüfung?	447	Dieter	22.11.01 10:53
Re: Dauerhafte Abfrage oder Überprüfung?	30	Toca	22.11.01 11:07
Re: Dauerhafte Abfrage oder Überprüfung?	432	Dieter	22.11.01 11:20
Re: Dauerhafte Abfrage oder Überprüfung?	88	Toca	22.11.01 11:48
Re: Dauerhafte Abfrage oder Überprüfung?	441	Dieter	22.11.01 12:24

Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden. Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  Gesamtübersicht

Suchen