lic Function ChinaNum(ByVal Num As String) As String
On Error GoTo ChinaNumErr
ChinaNum = \"\"

Dim str_tmp_CN As String
Dim str_tmp_ZS As String
Dim str_tmp_XS As String
Dim I As Long

If VBA.Trim(Num) = \"\" Then
GoTo ChinaNumErr
End If

For I = 1 To VBA.Len(Num) Step 1
Select Case VBA.Mid$(Num, I, 1)
Case \"1\", \"2\", \"3\", \"4\", \"5\", \"6\", \"7\", \"8\", \"9\", \"0\", \".\"
Case Else
GoTo ChinaNumErr
End Select
Next I

If Num Like \"*.*\" Then
If Num Like \"*.*.*\" Then
GoTo ChinaNumErr
End If
I = VBA.InStr(1, Num, \".\", vbTextCompare)
str_tmp_ZS = VBA.Left(Num, I - 1)
str_tmp_XS = VBA.Right(Num, VBA.Len(Num) - I)


str_tmp_ZS = zsTOstr(str_tmp_ZS)
str_tmp_XS = xsTOstr(str_tmp_XS)


If str_tmp_ZS = \"\" Then
str_tmp_CN = \"零\"
Else
str_tmp_CN = str_tmp_ZS
End If

If str_tmp_XS <> \"\" Then
str_tmp_CN = str_tmp_CN & \"点\" & str_tmp_XS
End If

End If
GoTo ChinaNumOK

ChinaNumOK:
If str_tmp_CN <> \"\" Then
Let ChinaNum = str_tmp_CN
Else
GoTo ChinaNumErr
End If
GoTo ChinaNumExit

ChinaNumErr:
Err.Clear
ChinaNum = \"\"
GoTo ChinaNumExit

ChinaNumExit:
´clear all money
str_tmp_CN = \"\"
str_tmp_ZS = \"\"
str_tmp_XS = \"\"
I = 0
Exit Function

End Function

Private Function zsTOstr(ByVal str_ZS As String) As String
On Error GoTo zsTOstrErr
If Not IsNumeric(str_ZS) Or str_ZS Like \"*.*\" Or str_ZS Like \"*-*\" Then
If Trim(str_ZS) <> \"\" Then
GoTo zsTOstrErr
End If
End If

If VBA.Len(str_ZS) > 16 Then
Let str_ZS = VBA.Left(str_ZS, 16)
End If

Dim Len As Integer, Counter As Integer
Dim strCh As String, strTempCh As String
Dim strSeqCh1 As String, strSeqCh2 As String
Dim str_ZS2Ch As String
str_ZS2Ch = \"零壹贰叁肆伍陆柒捌玖\"
strSeqCh1 = \" 拾佰仟 拾佰仟 拾佰仟 拾佰仟\"
strSeqCh2 = \" 万亿兆\"
str_ZS = CStr(CDec(str_ZS))
Len = Len(str_ZS)
For Counter = 1 To Len
strTempCh = Mid(str_ZS2Ch, Val(Mid(str_ZS, Counter, 1)) + 1, 1)
If strTempCh = \"零\" And Len <> 1 Then
If Mid(str_ZS, Counter + 1, 1) = \"0\" Or (Len - Counter + 1) Mod 4 = 1 Then
strTempCh = \"\"
End If
Else
strTempCh = strTempCh & Trim(Mid(strSeqCh1, Len - Counter + 1, 1))
End If
If (Len - Counter + 1) Mod 4 = 1 Then
strTempCh = strTempCh & Mid(strSeqCh2, (Len - Counter + 1) \\ 4 + 1, 1)
If Counter > 3 Then
If Mid(str_ZS, Counter - 3, 4) = \"0000\" Then strTempCh = Left(strTempCh, Len(strTempCh) - 1)


End If
End If
strCh = strCh & Trim(strTempCh)
Next
GoTo zsTOstrOK

zsTOstrOK:
Let zsTOstr = strCh
GoTo zsTOstrExit

zsTOstrErr:
Err.Clear
zsTOstr = \"\"
GoTo zsTOstrExit

zsTOstrExit:
strCh = \"\"
Len = 0
Counter = 0
strTempCh = \"\"
strSeqCh1 = \"\"
strSeqCh2 = \"\"
str_ZS2Ch = \"\"
Exit Function

End Function

Private Function xsTOstr(ByVal str_XS As String) As String
On Error GoTo xsTOstrErr
If Not IsNumeric(str_XS) Or str_XS Like \"*.*\" Or str_XS Like \"*-*\" Then
If Trim(str_XS) <> \"\" Then
GoTo xsTOstrErr
End If
End If

If VBA.Len(str_XS) > 20 Then
GoTo xsTOstrErr
End If

Dim str_TH As String
str_TH = \"零壹贰叁肆伍陆柒捌玖\"

Dim I As Long
Dim str_tmp_XS As String

For I = 1 To VBA.Len(str_XS) Step 1
str_tmp_XS = str_tmp_XS & VBA.Mid(str_TH, VBA.CInt(VBA.Mid(str_XS, I, 1)) + 1, 1)
Next I

If str_tmp_XS = \"\" Then
GoTo xsTOstrErr
End If

GoTo xsTOstrOK

xsTOstrOK:
Let xsTOstr = str_tmp_XS
GoTo xsTOstrExit

xsTOstrErr:
Err.Clear
xsTOstr = \"\"
GoTo xsTOstrExit

xsTOstrExit:
str_TH = \"\"
I = 0
str_tmp_XS = \"\"
Exit Function

End Function


以上代码来自: SourceCode Explorer(源代码数据库)
复制时间: 2002-06-12 19:27:13
当前版本: 1.0.705
作者: Shawls
个人主页:
E-Mail:
QQ: 9181729