Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Überprüfung von 2 Rechenwerten, ob diese Rechenbar sind (VB6)

Frage Entwicklung

Mitglied: JuanJespar

JuanJespar (Level 1) - Jetzt verbinden

05.06.2009, aktualisiert 10:26 Uhr, 4362 Aufrufe, 4 Kommentare

Hallo!
habe das Problem das ich für einen Einheitenrechner 2 verschiedene wertebereiche einbinden muss...
(g , kg, oz darf nicht mit den metrischen Recheneinheiten rechenbar sein)

hier der code

Option Explicit

Private Sub Command1_Click()

Dim dblEinheit0 As Double
Dim dblEinheit1 As Double

If Not IsNumeric(Text1.Text) Then
MsgBox "Bitte Zahlen eingeben!"
Else
Select Case Trim(Text2.Text)
Case "mm"
dblEinheit0 = CDbl(Text1.Text) * 1
Case "cm"
dblEinheit0 = CDbl(Text1.Text) * 10
Case "m"
dblEinheit0 = CDbl(Text1.Text) * 1000
Case "km"
dblEinheit0 = CDbl(Text1.Text) * 1000000
Case "in"
dblEinheit0 = CDbl(Text1.Text) * 25.4
Case "ft"
dblEinheit0 = CDbl(Text1.Text) * 304.8
Case "yd"
dblEinheit0 = CDbl(Text1.Text) * 914.4
Case "g"
dblEinheit0 = CDbl(Text1.Text) * 1
Case "kg"
dblEinheit0 = CDbl(Text1.Text) * 1
Case "oz"
dblEinheit0 = CDbl(Text1.Text) * 1
Case Else
MsgBox "Bitte eine Einheit angeben! (mm, cm , m ,km ,in ,ft ,yd ,g ,kg ,uz)"
End Select

Select Case Trim(Text3.Text)
Case "mm"
dblEinheit1 = dblEinheit0 * 1
Case "cm"
dblEinheit1 = dblEinheit0 / 10
Case "m"
dblEinheit1 = dblEinheit0 / 1000
Case "km"
dblEinheit1 = dblEinheit0 / 1000000
Case "in"
dblEinheit1 = dblEinheit0 / 25.4
Case "ft"
dblEinheit1 = dblEinheit0 / 304.8
Case "yd"
dblEinheit1 = dblEinheit0 / 914.4
Case "g"
dblEinheit1 = dblEinheit0 / 1
Case "kg"
dblEinheit1 = dblEinheit0 / 1
Case "oz"
dblEinheit1 = dblEinheit0 / 1
Case Else
MsgBox "Bitte eine Einheit angeben! (mm, cm , m ,km ,in ,ft ,yd ,g ,kg ,uz)"
End Select

End If

ausgabe.Caption = CStr(dblEinheit1)

End Sub

Private Sub Command2_Click()
End
End Sub
Mitglied: 76109
05.06.2009 um 12:01 Uhr
Hallo JuanJespar!

Das würde ich persönlich, anstatt mit Case über ListBoxen machen.

Etwa in der Art:

ListBox 1 alle Einheiten anzeigen und ListBox 2 alle Einheiten passend zur Auswahl von ListBox 1 anzeigen.

Oder: In jeder Case-Anweisung von Text2.Text z.B. ein Call EinheitLaenge()

01.
Private Sub EinheitLaenge() 
02.
  Select Case Trim(Text3.Text) 
03.
    Case "mm" 
04.
      dblEinheit1 = dblEinheit0 * 1 
05.
    Case "cm" 
06.
      dblEinheit1 = dblEinheit0 / 10 
07.
    ... 
08.
    Case Else 
09.
      MsgBox "Msg" 
10.
  End Select 
11.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: JuanJespar
05.06.2009 um 12:54 Uhr
Function Rechnelaenge() As Double

Dim dblAusgangswert As Double
Dim dblErgebniswert As Double

Select Case Trim(Ausgangseinheit.Text)
Case "mm"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1
Case "cm"
dblAusgangswert = CDbl(Ausgangswert.Text) * 10
Case "m"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1000
Case "km"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1000000
Case "in"
dblAusgangswert = CDbl(Ausgangswert.Text) * 25.4
Case "ft"
dblAusgangswert = CDbl(Ausgangswert.Text) * 304.8
Case "yd"
dblAusgangswert = CDbl(Ausgangswert.Text) * 914.4
Case Else
MsgBox "Bitte eine Längeneinheit angeben!"
End Select

Select Case Trim(Ergebniseinheit.Text)
Case "mm"
dblErgebniswert = dblAusgangswert * 1
Case "cm"
dblErgebniswert = dblAusgangswert / 10
Case "m"
dblErgebniswert = dblAusgangswert / 1000
Case "km"
dblErgebniswert = dblAusgangswert / 1000000
Case "in"
dblErgebniswert = dblAusgangswert / 25.4
Case "ft"
dblErgebniswert = dblAusgangswert / 304.8
Case "yd"
dblErgebniswert = dblAusgangswert / 914.4
Case Else
MsgBox "Bitte eine Längeneinheit angeben!"
End Select

Rechnelaenge = dblErgebniswert

End Function

Function Rechnegewicht() As Double

Dim dblAusgangswert As Double
Dim dblErgebniswert As Double

Select Case Trim(Ausgangseinheit.Text)
Case "g"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1
Case "kg"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1000
Case "oz"
dblAusgangswert = CDbl(Ausgangswert.Text) * 28.3495231
Case Else
MsgBox "Bitte eine Gewichtseinheit angeben!"
End Select

Select Case Trim(Ergebniseinheit.Text)
Case "g"
dblErgebniswert = dblAusgangswert * 1
Case "kg"
dblErgebniswert = dblAusgangswert / 1000
Case "oz"
dblErgebniswert = dblAusgangswert / 28.3495231
Case Else
MsgBox "Bitte eine Gewichtseinheit angeben!"
End Select

Rechnegewicht = dblErgebniswert

End Function
Bitte warten ..
Mitglied: JuanJespar
05.06.2009 um 15:27 Uhr
Zitat von JuanJespar:
Function Rechnelaenge() As Double

Dim dblAusgangswert As Double
Dim dblErgebniswert As Double

Select Case Trim(Ausgangseinheit.Text)
Case "mm"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1
Case "cm"
dblAusgangswert = CDbl(Ausgangswert.Text) * 10
Case "m"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1000
Case "km"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1000000
Case "in"
dblAusgangswert = CDbl(Ausgangswert.Text) * 25.4
Case "ft"
dblAusgangswert = CDbl(Ausgangswert.Text) * 304.8
Case "yd"
dblAusgangswert = CDbl(Ausgangswert.Text) * 914.4
Case Else
MsgBox "Bitte eine Längeneinheit
angeben!"
End Select

Select Case Trim(Ergebniseinheit.Text)
Case "mm"
dblErgebniswert = dblAusgangswert * 1
Case "cm"
dblErgebniswert = dblAusgangswert / 10
Case "m"
dblErgebniswert = dblAusgangswert / 1000
Case "km"
dblErgebniswert = dblAusgangswert / 1000000
Case "in"
dblErgebniswert = dblAusgangswert / 25.4
Case "ft"
dblErgebniswert = dblAusgangswert / 304.8
Case "yd"
dblErgebniswert = dblAusgangswert / 914.4
Case Else
MsgBox "Bitte eine Längeneinheit
angeben!"
End Select

Rechnelaenge = dblErgebniswert

End Function

Function Rechnegewicht() As Double

Dim dblAusgangswert As Double
Dim dblErgebniswert As Double

Select Case Trim(Ausgangseinheit.Text)
Case "g"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1
Case "kg"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1000
Case "oz"
dblAusgangswert = CDbl(Ausgangswert.Text) * 28.3495231
Case Else
MsgBox "Bitte eine Gewichtseinheit angeben!"
End Select

Select Case Trim(Ergebniseinheit.Text)
Case "g"
dblErgebniswert = dblAusgangswert * 1
Case "kg"
dblErgebniswert = dblAusgangswert / 1000
Case "oz"
dblErgebniswert = dblAusgangswert / 28.3495231
Case Else
MsgBox "Bitte eine Gewichtseinheit angeben!"
End Select

Rechnegewicht = dblErgebniswert

End Function

Bitte warten ..
Mitglied: 76109
05.06.2009 um 18:33 Uhr
Hallo JuanJespar!

Eigentlich hatte ich an etwas in der Art gedacht:
01.
Option Explicit 
02.
 
03.
Const MsgE = "Bitte eine Einheit angeben! (mm, cm , m ,km ,in ,ft ,yd ,g ,kg ,uz)" 
04.
Const MsgG = "Bitte eine Gewichtseinheit angeben!" 
05.
Const MsgL = "Bitte eine Längeneinheit angeben!" 
06.
 
07.
Private Sub CommandButton1_Click() 
08.
 
09.
    If Not IsNumeric(EingabeWert.Text) Then 
10.
        MsgBox "Bitte eine Zahl eingeben!" 
11.
    Else 
12.
        Select Case LCase(Trim(EingabeEinheit.Text)) 
13.
            Case "mm":  Call RechneLaenge(1) 
14.
            Case "cm":  Call RechneLaenge(10) 
15.
            Case "m":   Call RechneLaenge(1000) 
16.
            Case "km":  Call RechneLaenge(1000000) 
17.
            Case "in":  Call RechneLaenge(25.4) 
18.
            Case "ft":  Call RechneLaenge(304.8) 
19.
            Case "yd":  Call RechneLaenge(919.4) 
20.
            Case "g":   Call RechneGewicht(1) 
21.
            Case "kg":  Call RechneGewicht(1000) 
22.
            Case "oz":  Call RechneGewicht(28.3495231) 
23.
            Case Else:  MsgBox MsgE 
24.
        End Select 
25.
    End If 
26.
End Sub 
27.
 
28.
Private Sub RechneGewicht(ByVal Faktor As Double) 
29.
     
30.
    Dim Eingabe As Double, Ausgabe As Double 
31.
     
32.
    Eingabe = CDbl(EingabeWert.Text) * Faktor 
33.
     
34.
    Select Case LCase(Trim(AusgabeEinheit.Text)) 
35.
        Case "g":   Ausgabe = Eingabe 
36.
        Case "kg":  Ausgabe = Eingabe / 1000 
37.
        Case "oz":  Ausgabe = Eingabe / 28.3495231 
38.
        Case Else:  Ausgabe = 0:  MsgBox MsgG 
39.
    End Select 
40.
     
41.
    If Ausgabe = 0 Then Ergebnis.Caption = "" Else Ergebnis.Caption = CStr(Ausgabe) 
42.
End Sub 
43.
 
44.
Private Sub RechneLaenge(ByVal Faktor As Double) 
45.
 
46.
    Dim Eingabe As Double, Ausgabe As Double 
47.
     
48.
    Eingabe = CDbl(EingabeWert.Text) * Faktor 
49.
     
50.
    Select Case LCase(Trim(AusgabeEinheit.Text)) 
51.
        Case "mm":  Ausgabe = Eingabe 
52.
        Case "cm":  Ausgabe = Eingabe / 10 
53.
        Case "m":   Ausgabe = Eingabe / 1000 
54.
        Case "km":  Ausgabe = Eingabe / 1000000 
55.
        Case "in":  Ausgabe = Eingabe / 25.4 
56.
        Case "ft":  Ausgabe = Eingabe / 304.8 
57.
        Case "yd":  Ausgabe = Eingabe / 914.4 
58.
        Case Else:  Ausgabe = 0:  MsgBox MsgL 
59.
    End Select 
60.
 
61.
    If Ausgabe = 0 Then Ergebnis.Caption = "" Else Ergebnis.Caption = CStr(Ausgabe) 
62.
End Sub
Gruß Dieter

PS Setze Code-Formatierung so (ohne Dollarzeichen):
<$code>
Dein Code
<$/code>
Bitte warten ..
Ähnliche Inhalte
Batch & Shell
Passwort überprüfung
Frage von Robin99Batch & Shell4 Kommentare

Hallo, ich bin am ende ich weiß nicht was hier falsch ist: Kann mir da jmd. weiterhelfen? Danke :D ...

Microsoft Office
Excel Wenn Überprüfungen
Frage von moritzhdMicrosoft Office

Hallo zusammen, ich habe folgendes Problem. Ich habe eine Liste von Daten, mit ArtikellNr., Lieferstatusen, Liefernummern (und weiteren Informationen, ...

Batch & Shell
Überprüfung in Batch Datei
gelöst Frage von tkacbgindBatch & Shell7 Kommentare

Hallo, ich habe eine ganz einfache Batch Datei sie einfach nur 16 Excell Dateien öffnen soll echo off echo ...

Batch & Shell
Rechteänderung von TS Profilen mit SamAccountName Überprüfung
gelöst Frage von pixel0815Batch & Shell4 Kommentare

Moin zusammen, mit folgenden Zeilen verändere ich die Rechte von Terminalserver Profilen: Wie kann ich jetzt am besten prüfen ...

Neue Wissensbeiträge
Erkennung und -Abwehr

Necur-Botnet soll Erpressungstrojaner Scarab massenhaft verbreiten

Information von BassFishFox vor 8 StundenErkennung und -Abwehr

12,5 Millionen Spam-Mails aus einem Bot-Netz mit 6 Millionen Computern? Eigentlich eine schwache Leistung. Die Erpresser setzen dabei auf ...

Microsoft

Nadeldrucker-Problem unter Windows - Microsoft liefert Updates

Information von BassFishFox vor 8 StundenMicrosoft

Hat ja nicht lange gedauert. Nachdem die November-Updates für Windows 7, 8.1 und 10 zahlreiche Nadeldrucker lahmgelegt hatten, stellt ...

Linux

Limux-Ende in München: Wie ein Linux Projekt unter Ausschluss der Öffentlichkeit zerstört wurde

Information von Frank vor 16 StundenLinux14 Kommentare

Mein persönlicher Kommentar zum Thema "Limux-Ende". Die SPD-Politikerin Anne Hübner hat die Richtung von München ganz klar definiert: "Wir ...

Batch & Shell

Open Object Rexx: Eine mittlerweile fast vergessene Skriptsprache aus dem Mainframebereich

Information von Penny.Cilin vor 1 TagBatch & Shell9 Kommentare

Ich kann mich noch sehr gut an diese Skriptsprache erinnern und nutze diese auch heute ab und an noch. ...

Heiß diskutierte Inhalte
Windows Server
Kann man im KMS nachschauen , wieviele Clients den Key in Anspruch genommen haben
gelöst Frage von rainergugusWindows Server15 Kommentare

Hallo, wir haben einen KMS Windows 10 Key. Dieser ist ja W7 kompatibel. Aber unser Windows 7 Pool registriert ...

Linux
Limux-Ende in München: Wie ein Linux Projekt unter Ausschluss der Öffentlichkeit zerstört wurde
Information von FrankLinux14 Kommentare

Mein persönlicher Kommentar zum Thema "Limux-Ende". Die SPD-Politikerin Anne Hübner hat die Richtung von München ganz klar definiert: "Wir ...

Router & Routing
Zwei Netzwerke erstellen
Frage von bunteblumeRouter & Routing14 Kommentare

Hallo Zusammen, Ich möchte gerne ein backup von einem bestimmten Folder welcher auf dem Server regelmässig synchronisiert wird auf ...

Off Topic
Fachkräftemangel in Deutschland? - Talentschmiede schreibt alle 2 Tage die gleichen Stellen aus
Frage von Penny.CilinOff Topic12 Kommentare

Hallo, haben wir in Deutschland Fachkräftemangel? Die Talentschmiede schreibt gefühlt alle zwei Tage dieselben Stellen aus. Und das schon ...