夕阳醉了's Blog

Private Sub Command1_Click()
             label1.Text = ""
             label1.Text = GetChinaMoney(Text1.Text)
End Sub

Private Sub Form_Load()
          Text1.MaxLength = 16
           Text1.Text = ""
           label1.Text = ""
         Text1.Text = "987654321"

End Sub


-----------------------------Module1.bas---------------------------------------------------------




Public Function GetChinaMoney(ByVal strNumber) As String
Dim a() As String
Dim s1 As String, s2 As String
Dim l1 As String
Dim s3 As String
Dim strEng As String


strEng2Ch = "零壹贰叁肆伍陆柒捌玖"


If Not IsNumeric(strNumber) Then
If Trim(strNumber) <> "" Then MsgBox "无效的数字"
GetChinaMoney = ""

Exit Function
End If

l1 = InStr(strNumber, ".")
If l1 <> 0 Then
s1 = Left(strNumber, l1 - 1)
s2 = Mid(strNumber, l1 + 1)
Else
s1 = strNumber
s2 = "0"
End If

s1 = Dig2Chinese_pb(s1)

s3 = ""
If s2 <> 0 Then
For i = 1 To Len(s2)
If i = 1 Then s3 = s3 & Mid(strEng2Ch, Val(Mid(s2, i, 1)) + 1, 1) & "角"
If i = 2 Then s3 = s3 & Mid(strEng2Ch, Val(Mid(s2, i, 1)) + 1, 1) & "分"
If i = 3 Then s3 = s3 & Mid(strEng2Ch, Val(Mid(s2, i, 1)) + 1, 1) & "厘"
If i = 4 Then s3 = s3 & Mid(strEng2Ch, Val(Mid(s2, i, 1)) + 1, 1) & "毫"
Next
End If

GetChinaMoney = s1 & "圆" & s3


End Function


Public Function Dig2Chinese_pb(strEng As String) As String

Dim intLen As Integer, intCounter As Integer
Dim strCh As String, strtempCh As String
Dim strSeqCh1 As String, strSeqCh2 As String
Dim strEng2Ch As String
Dim sTemp As String
Dim i As Integer


Dim iWanBit As Integer
Dim iYiBit As Integer
Dim iWanYiBit As Integer


Dim sFoward As String


iWanBit = 0: iYiBit = 0: iWanYiBit = 0
sFoward = StrReverse(strEng)


For i = 1 To Len(sFoward)
Dim val1 As Long

val1 = Val(Mid(sFoward, i, 1))
If i >= 5 And i <= 8 Then
If iWanBit = 0 Then
If val1 <> 0 Then iWanBit = i
End If
End If


If i >= 9 And i <= 12 Then
If iYiBit = 0 Then
If val1 <> 0 Then iYiBit = i
End If
End If


If i >= 13 And i <= 16 Then
If iWanYiBit = 0 Then
If val1 <> 0 Then iWanYiBit = i
End If
End If


Next


If Not IsNumeric(strEng) Then
If Trim(strEng) <> "" Then MsgBox "无效的数字"
Dig2Chinese_pb = ""

Exit Function
End If

If Len(strEng) > 15 Then
MsgBox "数字位数太长"
Dig2Chinese_pb = ""

Exit Function

End If

strEng2Ch = "零壹贰叁肆伍陆柒捌玖"
strSeqCh1 = " 拾佰仟 拾佰仟 拾佰仟 拾佰仟"
strSeqCh2 = " 万亿兆"

'转换为表示数值的字符串
strEng = CStr(CDec(strEng))

'len
intLen = Len(strEng)

'change to chinese
For intCounter = 1 To intLen
strtempCh = Mid(strEng2Ch, Val(Mid(strEng, intCounter, 1)) + 1, 1)


If strtempCh = "零" And intLen <> 1 Then
' If Mid(strEng, intCounter + 1, 1) = "0" Or (intLen - intCounter + 1) Mod 4 = 1 Then


'若之后一个也是零，或在最后，则不显示"零"
If Mid(strEng, intCounter + 1, 1) = "0" Or intCounter = intLen Then
strtempCh = ""
End If
Else
'添加位 拾佰仟
If strtempCh <> "零" Then strtempCh = strtempCh & Trim(Mid(strSeqCh1, intLen - intCounter + 1, 1))

End If



'添加位 "万"(5-8),"亿"(9-12),"万亿"(13-16)
' iWanBit = 0: iYiBit = 0: iWanYiBit = 0
If intCounter = Len(strEng) + 1 - iWanBit Then strtempCh = strtempCh & "万"
If intCounter = Len(strEng) + 1 - iYiBit Then strtempCh = strtempCh & "亿"
If intCounter = Len(strEng) + 1 - iWanYiBit Then strtempCh = strtempCh & "万亿"


'组成汉字
strCh = strCh & Trim(strtempCh)

Next

Dig2Chinese_pb = strCh
End Function