Die Funktion CVTyp wandelt einen beliebigen an sie übergebenen Wert in einen für den Datentyp gültigen Wert (Rückgabewert). ' Test-UDT Private Type vb_Variable nBool As Boolean nInteger As Integer nLong As Long nSingle As Single nDouble As Double dDate As Date sString As String * 25 End Type ' TestAufruf ' Füllen eines UDT's (user defined type) mit ' für den Datentyp gültigen Werten Private Function ConvVariable() As Integer Dim CV As Long Dim udtWert As vb_Variable Dim vArray() As Variant Dim V As Variant On Error GoTo Err_CV ' TestArray vArray = Array(True, 999, 99999999, 99.9, "25.02.2008", "vb@rchiv", "") With udtWert CV = CVTyp(.nBool, vArray(0)) CV = CVTyp(.nInteger, vArray(1)) CV = CVTyp(.nLong, vArray(2)) CV = CVTyp(.nSingle, vArray(3)) CV = CVTyp(.nDouble, vArray(4)) ' XIn: ein DatumsType CV = CVTyp(.dDate, vArray(4)) CV = CVTyp(.sString, vArray(5)) End With MsgBox vArray(4) & vbCr & udtWert.nDouble & _ vbCr & vbCr & vArray(5) & vbCr & udtWert.sString, _ vbInformation, "TestAufruf" & Space(50) With udtWert CV = CVTyp(.nBool, vArray(6)) ' XIn: "" End With MsgBox vArray(6) & vbCr & udtWert.nBool, _ vbInformation, "TestAufruf" & Space(50) With udtWert CV = CVTyp(.sString, V) ' XIn: leer oder NULL End With MsgBox "[leer oder NULL]" & vbCr & udtWert.sString, _ vbInformation, "TestAufruf" & Space(50) Exit_CV: Exit Function Err_CV: MsgBox Err & vbCr & Err.Description, vbInformation, "ConvVariable" Resume Exit_CV End Function ' Datentypische Umwandlung eines beliebigen Wertes Function CVTyp(XOut As Variant, XIn As Variant) As Long Dim XVal As Variant Dim XTyp As Integer On Error GoTo Err_CVTyp ' check den VariablenTyp des Rückgabewertes (XOut) XTyp = VarType(XOut) ' Selektion an Hand des DatenTyps ' und datentypische Umwandlung des Einganswertes (XIn) Select Case XTyp Case vbBoolean If XIn > "" Then XVal = CBool(XIn) Else XVal = False End If Case vbInteger XVal = CInt(Val(XIn)) Case vbLong XVal = CLng(Val(XIn)) Case vbDate If Not IsDate(XIn) Then XIn = Now XVal = CDate(XIn) Case vbSingle If Not IsNumeric(XIn) Then XIn = 0 XVal = CSng(XIn) Case vbDouble If Not IsNumeric(XIn) Then XIn = 0 XVal = CDbl(XIn) Case vbString If IsNull(XIn) Then XIn = "" XVal = CStr(XIn) Case vbUserDefinedType Case Else XVal = "" End Select XOut = XVal CVTyp = XTyp Exit_CVTyp: Exit Function Err_CVTyp: XOut = 0 MsgBox Err & vbCr & Err.Description, vbCritical, "CVTyp" Resume Exit_CVTyp End Function Dieser Tipp wurde bereits 8.612 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |