change_chinese.txt

把数值转为大写金额, 把数值转为大写金额

'把数值转为大写金额
'by Oscar 2002/9/11
Public Function Chinese_Num(ByVal p_num As Double)
If p_num > 9999999999999.99 Then
    Chinese_Num = "天文数字"
    Exit Function
End If

Dim w_num As String
Dim w_leftnum As String
Dim w_rightnum As String
Dim w_str As String
Dim W_Str2 As String
Dim W_Char As String
Dim i As Long

w_num = CStr(Format(p_num, ".00"))
w_leftnum = Left(w_num, Len(w_num) - 3)
w_rightnum = Right(w_num, 2)
w_str = ""
W_Char = ""
For i = 1 To Len(w_leftnum)
     W_Char = Left(Right(w_leftnum, i), 1)
     Select Case W_Char
     Case "0"
         
         W_Char = "零"
     Case "1"
         W_Char = "壹"
     Case "2"
         W_Char = "贰"
     Case "3"
         W_Char = "叁"
     Case "4"
         W_Char = "肆"
     Case "5"
         W_Char = "伍"
     Case "6"
         W_Char = "陆"
     Case "7"
         W_Char = "柒"
     Case "8"
         W_Char = "捌"
     Case "9"
         W_Char = "玖"
     End Select
     
    Select Case i
    Case 1
        W_Char = W_Char & ""
    Case 2, 6, 10, 14
        W_Char = W_Char & "拾"
    Case 3, 7, 11, 15
        W_Char = W_Char & "佰"
    Case 4, 8, 12, 16
        W_Char = W_Char & "仟"
    Case 5, 13
        W_Char = W_Char & "万"
    Case 9
        W_Char = W_Char & "亿"
    End Select
     w_str = W_Char & w_str
Next i

If Val(w_rightnum) > 0 Then
    W_Str2 = ""
    For i = 1 To Len(w_rightnum)
        W_Char = Mid(w_rightnum, i, 1)
        Select Case W_Char
        Case "0"
            
            W_Char = "零"
        Case "1"
            W_Char = "壹"
        Case "2"
            W_Char = "贰"
        Case "3"
            W_Char = "叁"
        Case "4"
            W_Char = "肆"
        Case "5"
            W_Char = "伍"
        Case "6"
            W_Char = "陆"
        Case "7"
            W_Char = "柒"
        Case "8"
            W_Char = "捌"
        Case "9"
            W_Char = "玖"
        End Select
        
        If W_Char <> "零" Then
            Select Case i
            Case 1
                W_Char = W_Char & "角"
            Case 2
                W_Char = W_Char & "分"
            End Select
        End If
        If i = Len(w_rightnum) And W_Char = "零" Then
            W_Char = ""
        End If
        W_Str2 = W_Str2 & W_Char
    Next i
    
End If

w_str = Replace(w_str, "零拾", "零")
w_str = Replace(w_str, "零佰", "零")
w_str = Replace(w_str, "零仟", "零")
w_str = Replace(w_str, "零零零", "零")
w_str = Replace(w_str, "零零", "零")
w_str = Replace(w_str, "零万", "万")
w_str = Replace(w_str, "零亿", "亿")
w_str = Replace(w_str, "亿万", "亿")

If Right(w_str, 1) = "零" Then
    w_str = Left(w_str, Len(w_str) - 1)
End If

w_str = w_str & "元" & W_Str2 & "整"

Chinese_Num = w_str

End Function