vb代码：一个方法可将数字金额变为大写

答案：
'大写
Const strN = "零壹贰叁肆伍陆柒捌玖"
Const strG = "拾佰仟万亿"
Const intN = "0123456789"
Dim Zero_Count As Long '读零计数
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_BADDB = 1009&
Private Const ERROR_BADKEY = 1010&
Private Const ERROR_CANTOPEN = 1011&
Private Const ERROR_CANTREAD = 1012&
Private Const ERROR_CANTWRITE = 1013&
Private Const ERROR_OUTOFMEMORY = 14&
Private Const ERROR_INVALID_PARAMETER = 87&
Private Const ERROR_ACCESS_DENIED = 5&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234&
 

Private Function GetN(ByVal N As Long) As String
GetN = Mid(strN, N + 1, 1)
End Function
Private Function GetG(ByVal G As Long) As String
Select Case G
Case 1
GetG = ""
Case 2, 6
GetG = Mid(strG, 1, 1)
Case 3, 7
GetG = Mid(strG, 2, 1)
Case 4, 8
GetG = Mid(strG, 3, 1)
Case 5
GetG = Mid(strG, 4, 1)
Case 9
GetG = Mid(strG, 5, 1)
End Select
End Function
Private Function ReadLongNumber(ByVal LongX As String) As String
Dim NumberX As String
Dim l As Long '长度
Dim m As Long '多余位数
Dim c As Long '循环次数
Dim i As Long, j As Long '标志
Dim CurN As String
NumberX = LongX
l = Len(NumberX)
Do Until l < 9
m = l Mod 8
If m = 0 Then m = 8
CurN = Left(NumberX, m)
If ReadIntNumber(CurN) <> "零" Then
ReadLongNumber = ReadLongNumber & ReadIntNumber(CurN) & "亿"
Else
ReadLongNumber = ReadLongNumber & "亿"
End If
NumberX = Right(NumberX, Len(NumberX) - m)
l = Len(NumberX)
Loop
ReadLongNumber = ReadLongNumber & ReadIntNumber(NumberX)
If Len(ReadLongNumber) > 2 And Right(ReadLongNumber, 1) = "零" Then '去尾 零
ReadLongNumber = Left(ReadLongNumber, Len(ReadLongNumber) - 1)
End If
If Mid(ReadLongNumber, 1, 2) = "壹拾" Then '掐头 壹拾
ReadLongNumber = Right(ReadLongNumber, Len(ReadLongNumber) - 1)
Mid(ReadLongNumber, 1, 1) = "拾"
End If
Zero_Count = 0
End Function
Private Function ReadIntNumber(ByVal NumberX As String) As String
Dim l As Long '长度
Dim m As Long '多余位数
Dim c As Long '循环次数
Dim i As Long, j As Long '标志
Dim CurN As String
If Val(NumberX) = 0 Then ReadIntNumber = GetN(0): Exit Function
l = Len(NumberX)
If l > 8 Then Exit Function
m = l Mod 9
CurN = Right(NumberX, m)
For i = Len(CurN) To 1 Step -1
If GetN(Int(Mid(CurN, i, 1))) = "零" And Zero_Count = 1 Then
If GetG(Len(CurN) - i + 1) = "万" Then
If (Not (Val(Left(CurN, Len(CurN) - 5)) = 0)) Then ReadIntNumber = GetG(Len(CurN) - i + 1) & ReadIntNumber
End If
Else
If GetN(Int(Mid(CurN, i, 1))) = "零" Then
ReadIntNumber = GetN(Int(Mid(CurN, i, 1))) & ReadIntNumber
If GetG(Len(CurN) - i + 1) = "万" Then
If (Not (Val(Left(CurN, Len(CurN) - 5)) = 0)) Then ReadIntNumber = GetG(Len(CurN) - i + 1) & ReadIntNumber
End If
Zero_Count = 1
Else
ReadIntNumber = GetG(Len(CurN) - i + 1) & ReadIntNumber
ReadIntNumber = GetN(Int(Mid(CurN, i, 1))) & ReadIntNumber
Zero_Count = 0
End If
End If
Next i
'Loop
If Len(ReadIntNumber) > 2 And Right(ReadIntNumber, 1) = "零" Then '去尾 零
ReadIntNumber = Left(ReadIntNumber, Len(ReadIntNumber) - 1)
End If
If Mid(ReadIntNumber, 1, 2) = "壹拾" Then '掐头 壹拾
ReadIntNumber = Right(ReadIntNumber, Len(ReadIntNumber) - 1)
Mid(ReadIntNumber, 1, 1) = "拾"
End If
End Function
Public Function ReadNumber(ByVal NumberX As String) As String
Dim LongX As String
Dim PointX As String
Dim LongLong As Long
Dim bFS As Boolean '负数
If Not IsNumeric(NumberX) Then
ReadNumber = ""
Exit Function
End If
If CDbl(NumberX) < 0 Then
NumberX = -NumberX
bFS = True
End If
NumberX = CStr(Format(NumberX, "General Number"))
LongLong = InStr(1, NumberX, ".")
If LongLong <> 0 Then
ReadNumber = ReadLongNumber(Left(NumberX, LongLong - 1))
ReadNumber = ReadNumber & "点" & ReadSmallNumber(Right(NumberX, Len(NumberX) - LongLong))
Else
ReadNumber = ReadLongNumber(NumberX)
End If
If bFS = True Then
ReadNumber = "负" & ReadNumber
End If
End Function
Private Function ReadSmallNumber(SmallNumber As String) As String
Dim i As Long
For i = 1 To Len(SmallNumber)
ReadSmallNumber = ReadSmallNumber & GetN(Mid(SmallNumber, i, 1))
Next i
End Function
Private Function ReadSmallNumberToRMB(SmallNumber As String) As String
ReadSmallNumberToRMB = GetN(Mid(SmallNumber, 1, 1)) & "角" & GetN(Mid(SmallNumber, 2, 1)) & "分"
End Function
Public Function ReadNumberToRMB(ByVal NumberX As String) As String
Dim LongX As String
Dim PointX As String
Dim LongLong As Long
Dim bFS As Boolean '负数
If Not IsNumeric(NumberX) Then
ReadNumberToRMB = ""
Exit Function
End If
If CDbl(NumberX) < 0 Then
NumberX = -NumberX
bFS = True
End If
NumberX = CStr(Format(NumberX, "#.00"))
LongLong = InStr(1, NumberX, ".")
If Right(NumberX, Len(NumberX) - LongLong) <> "" Then
ReadNumberToRMB = ReadLongNumber(Left(NumberX, LongLong - 1))
ReadNumberToRMB = ReadNumberToRMB & "元" & ReadSmallNumberToRMB(Right(NumberX, Len(NumberX) - LongLong))
Else
ReadNumberToRMB = ReadLongNumber(NumberX)
End If
If bFS = True Then
ReadNumberToRMB = "负" & ReadNumberToRMB
End If
End Function

 
Function daxie(money As String) As String '
  Dim x As String, y As String
  Const zimu = ".sbqwsbqysbqwsbq" '定义位置代码
  Const letter = "0123456789sbqwy.jzf" '定义数字及汉字缩写
  Const upcase = "零壹贰叁肆伍陆柒捌玖拾佰仟万亿圆角整分"   '定义大写汉字
  Dim temp As String
  temp = money
      If InStr(temp, ".") > 0 Then
            temp = Left(temp, InStr(temp, ".") - 1)
      ElseIf Len(temp) > 16 Then
            MsgBox "数目太大，无法换算！请输入一亿亿以下的数字", 64, "错误提示": Exit Function '只能转换一亿亿元以下数目的货币！
      End If
   x = Format(money, "0.00") '格式化货币
   y = ""
     For i = 1 To Len(x) - 3
         y = y & Mid(x, i, 1) & Mid(zimu, Len(x) - 2 - i, 1)
     Next
       If Right(x, 3) = ".00" Then
              y = y & "z"          '***元整
       Else
              y = y & Left(Right(x, 2), 1) & "j" & Right(x, 1) & "f"     '*元*角*分
       End If
    y = Replace(y, "0q", "0") '避免零千(如：40200肆万零千零贰佰)
    y = Replace(y, "0b", "0") '避免零百(如：41000肆万壹千零佰)
    y = Replace(y, "0s", "0") '避免零十(如：204贰佰零拾零肆)
    y = Replace(y, "0j", "0")  '避免零角
    y = Replace(y, "0f", "整")
  Do While y <> Replace(y, "00", "0")
          y = Replace(y, "00", "0") '避免双零(如：1004壹仟零零肆)
  Loop
     y = Replace(y, "0y", "y") '避免零亿(如：210亿     贰佰壹十零亿)
     y = Replace(y, "0w", "w") '避免零万(如：210万     贰佰壹十零万)
     y = IIf(Len(x) = 5 And Left(y, 1) = "1", Right(y, Len(y) - 1), y) '避免壹十(如：14壹拾肆；10壹拾)
     y = IIf(Len(x) = 4, Replace(y, "0.", ""), Replace(y, "0.", ".")) '避免零元(如：20.00贰拾零圆；0.12零圆壹角贰分)
  For i = 1
上一个：关于VB中怎么让flash播放器的一个功能实现
下一个：vb代码求教如何设置按钮，框框，一键剪切
更多图片编程知识: