Private Sub Command1_Click()
Label1.Caption = rmb(Val(Text1.Text))
End Sub
Private Function rmb(s As Currency) As String
Dim s2, s1, dx, x, c1, c2 As String
Dim l As Integer
s1 = LTrim(Str(Abs(s)))
l = Len(s1)
Select Case l - InStrRev(s1, ".")
Case l
s2 = s1 + ".00"
Case 1
s2 = s1 + "0"
Case 2
s2 = s1
End Select
l = Len(s2)
dx = ""
c1 = "零壹贰叁肆伍陆柒捌玖“"
c2 = "分角 元拾佰仟万拾佰仟亿拾佰”"
Do While l >= 1
x = Mid(s2, Len(s2) - l + 1, 1)
dx = dx + IIf(x <> ".", Mid(c1, Val(x) + 1, 1) + Trim(Mid(c2, (l - 1) + 1, 1)), "")
l = l - 1
Loop
rmb = dx
End Function