vba:cast:cvalue
Differences
This shows you the differences between two versions of the page.
| Both sides previous revision Previous revision Next revision | Previous revision | ||
|
vba:cast:cvalue [31.08.2015 10:27:57] yaslaw |
vba:cast:cvalue [19.10.2015 12:37:48] (current) yaslaw |
||
|---|---|---|---|
| Line 1: | Line 1: | ||
| <const> | <const> | ||
| - | version=1.2.0 | + | version=1.3.0 |
| - | vdate=31.08.2015 | + | vdate=19.10.2015 |
| fname=cast_cvalue.bas | fname=cast_cvalue.bas | ||
| ns=%NAMESPACE% | ns=%NAMESPACE% | ||
| Line 159: | Line 159: | ||
| ==== Nur Kurzversion cV ==== | ==== Nur Kurzversion cV ==== | ||
| <code vb>'/** | <code vb>'/** | ||
| - | ' * Dies ist die Minimalversion von cValue (V1.0.0): http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cvalue | + | ' * Dies ist die Minimalversion von cValue (V1.3.0): http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cvalue |
| - | ' * Der 2te Paramtersteuert das Null-Verhalten('seb'): | + | ' * @example myDict.Add(1, cV("True", "b")) |
| - | ' * n: Der Text Null ohne Delemiter wird als Wert Null intepretiert, | + | ' * @param Variant Wert der geparst wird |
| - | ' * e: Ein leerer String wird als Null intepretiert, | + | ' * @param String Flag ('nebd') |
| - | ' * b: Boolean-Text wird als Boolean intepretiert | + | ' * n: Der Text Null ohne Delemiter wird als Wert Null intepretiert: "NULL" -> Null |
| - | ' * d: Bei Delemited Strings den Delemiter entfernen. ' oder " gelten als Delemiter | + | ' * e: Ein leerer String wird als Null intepretiert, "" -> Null |
| + | ' * b: Boolean-Text wird als Boolean intepretiert "True" -> True (Boolean) | ||
| + | ' * d: Bei Delemited Strings den Delemiter nicht entfernen. ' oder " gelten als Delemiter: "'Hans'" -> Hans | ||
| + | ' * @return Variant | ||
| ' */ | ' */ | ||
| Public Function cV(ByVal iValue As Variant, Optional ByVal iFlags As String) As Variant | Public Function cV(ByVal iValue As Variant, Optional ByVal iFlags As String) As Variant | ||
| On Error Resume Next: If IsNull(iValue) Then cV = Null: Exit Function | On Error Resume Next: If IsNull(iValue) Then cV = Null: Exit Function | ||
| - | Static rxDa As Object, rsDs As Object: Dim sm As Object, str As String, flg As String: str = CStr(iValue): flg = UCase(iFlags) | + | If Not VarType(iValue) = 8 Then cV = iValue: Exit Function |
| + | Static rxDa As Object, rxDs As Object: Dim sm As Object, str As String, flg As String: str = CStr(iValue): flg = UCase(iFlags) | ||
| If UCase(str) = "NULL" And InStr(flg, "N") Then cV = Null: Exit Function | If UCase(str) = "NULL" And InStr(flg, "N") Then cV = Null: Exit Function | ||
| If iValue = Empty And CBool(InStr(flg, "E")) Then cV = Null: Exit Function | If iValue = Empty And CBool(InStr(flg, "E")) Then cV = Null: Exit Function | ||
| - | If IsDate(str) Then cV = CDate(str): Exit Function | ||
| cV = CByte(str): If cV = str Then Exit Function | cV = CByte(str): If cV = str Then Exit Function | ||
| cV = CInt(str): If cV = str Then Exit Function | cV = CInt(str): If cV = str Then Exit Function | ||
| Line 177: | Line 180: | ||
| cV = CDbl(str): If cV = str Then Exit Function | cV = CDbl(str): If cV = str Then Exit Function | ||
| cV = CDec(str): If cV = str Then Exit Function | cV = CDec(str): If cV = str Then Exit Function | ||
| - | Err.Clear: If InStr(flg, "B") Then cV = CBool(str): If Err.Number = 0 Then Exit Function | + | If IsDate(str) Then cV = CDate(str): Exit Function |
| + | Err.clear: If InStr(flg, "B") Then cV = CBool(str): If Err.Number = 0 Then Exit Function | ||
| If rxDa Is Nothing Then Set rxDa = CreateObject("VBScript.RegExp"): rxDa.pattern = "^#(.*)#$" | If rxDa Is Nothing Then Set rxDa = CreateObject("VBScript.RegExp"): rxDa.pattern = "^#(.*)#$" | ||
| - | If rxDa.Test(str) Then cV = CDate(rxDa.execute(str)(0).subMatches(0)): Exit Function | + | If rxDa.test(str) Then cV = CDate(rxDa.execute(str)(0).subMatches(0)): Exit Function |
| - | If InStr(flg, "D") Then | + | If InStr(flg, "D") > 0 Then cV = iValue: Exit Function |
| - | If rsDs Is Nothing Then Set rsDs = CreateObject("VBScript.RegExp"): rsDs.pattern = "^([""'])(.*)\1$" | + | If rxDs Is Nothing Then Set rxDs = CreateObject("VBScript.RegExp"): rxDs.pattern = "^[#""'\[](.*)([""'#\]])$" |
| - | If rsDs.Test(str) Then Set sm = rsDs.execute(str)(0).subMatches: cV = Replace(sm(1), "\" & sm(0), sm(0)): Exit Function | + | If rxDs.test(str) Then Set sm = rxDs.execute(str)(0).subMatches: cV = Replace(sm(0), "\" & sm(1), sm(1)): Exit Function |
| - | End If | + | |
| cV = iValue | cV = iValue | ||
| - | End Function | + | End Function</code> |
| - | </code> | + | |
vba/cast/cvalue.1441009677.txt.gz · Last modified: 31.08.2015 10:27:57 by yaslaw
Page Tools
Except where otherwise noted, content on this wiki is licensed under the following license: GNU Free Documentation License 1.3
