转换金额大写--代码

sdzblbf

Option Compare Database

Dim Num_To_Chinese(10) As String
Dim num_to_china(14) As String

   Sub Init_Chinese()

   Num_To_Chinese(0) = "零"
   Num_To_Chinese(1) = "壹"
   Num_To_Chinese(2) = "贰"
   Num_To_Chinese(3) = "叁"
   Num_To_Chinese(4) = "肆"
   Num_To_Chinese(5) = "伍"
   Num_To_Chinese(6) = "陆"
   Num_To_Chinese(7) = "柒"
   Num_To_Chinese(8) = "捌"
   Num_To_Chinese(9) = "玖"

   End Sub
   Sub Init_China()
   num_to_china(0) = "分"
   num_to_china(1) = "角"
   num_to_china(2) = "元"
   num_to_china(3) = "拾"
   num_to_china(4) = "佰"
   num_to_china(5) = "仟"
   num_to_china(6) = "万"
   num_to_china(7) = "拾"
   num_to_china(8) = "佰"
   num_to_china(9) = "仟"
   num_to_china(10) = "亿"
   num_to_china(11) = "拾"
   num_to_china(12) = "佰"
   num_to_china(13) = "仟"
   num_to_china(14) = "万"
   End Sub

   Function Get_China(ByVal m As Currency) As String
   Dim temp As String
   Dim mm As String
   Dim kd, i As Integer
   i = 0
   Init_Chinese
   Init_China
   mm = Str(Round(m * 100))
   kd = Len(mm)
   If Right(mm, 2) = "00" Then
   temp = "整"
   Else
   temp = Nz("")
   End If
   
   For i = 0 To kd - 2 Step 1
   If Mid(mm, kd - i, 1) = "0" Then
       If (i = 1) And (Left(temp, 1) <> "整") Then temp = "零" & temp
       If (i > 2 And i <> 10) And (Left(temp, 1) <> "零" And Left(temp, 1) <> "元" And Left(temp, 1) <> "万" And Left(temp, 1) <> "亿") Then temp = "零" & temp
       If i = 2 Then temp = "元" & temp
        If (i = 6 And kd < 11) Then temp = "万" & temp '2003,7,28修改过
          If kd >= 11 Then
          If (i = 6 And Mid(mm, kd - 9, 3) <> "000") Then temp = "万" & temp '2003,7,28增加
          End If
        If i = 10 Then temp = "亿" & temp  '2003,7,28增加
        'If i = 10 And Left(temp, 2) = "万元" Then temp = "亿" & Right(temp, Len(temp) - 1)'2003,7,28修改过
     temp = Nz("") & temp
   Else
        If num_to_china(i) = "亿" And Left(temp, 2) = "万元" Then
        'temp = Num_To_Chinese(Mid(mm, kd - i, 1)) & num_to_china(i) & Right(temp, Len(temp) - 1)'2003,7,28修改过
        Else
        temp = Num_To_Chinese(Mid(mm, kd - i, 1)) & num_to_china(i) & temp
        End If
   End If
   Next
   Get_China = temp
   End Function
   
   
      Function Get_xx(ByVal m As Currency) As String
   Dim temp As String
   Dim mm As String
   Dim kd, i As Integer
   i = 0
   mm = Str(Round(m * 100))
   kd = Len(mm)
   temp = Nz("")
   
   For i = 0 To kd - 2 Step 1
        temp = Mid(mm, kd - i, 1) & " " & temp
   Next
   Get_xx = temp
   End Function