怎样将一长串阿拉伯数字转变为人民币大写，特别是中间的零的处理？

Question

1、要求做成.dll文件，能在其他程序语言里调用。
2、最好有代码和详细注释。

Answer 1

Private Function Num2Chi(txtJE As Double) As String
    Dim I, K As Integer
    Dim NC, nd, ka, chrNum, strZheng As String
    Dim c1, c2, c3 As String
    Dim K1 As Integer
    Dim Zheng As String
    Dim Xiao As String
    NC = Trim(Format(txtJE, "##0.00"))
    c1 = "仟佰拾万仟佰拾亿仟佰拾万仟佰拾元"
    c2 = "角分"
    c3 = "玖捌柒陆伍肆叁贰壹"
    If NC = 0 Then
        Num2Chi = "零元整"
        Exit Function
    End If
    Num2Chi = ""
    Zheng = Mid(NC, 1, (Len(NC) - 3))
    Xiao = Mid(NC, (Len(Zheng) + 2))
    If Val(Xiao) <> 0 Then
        For I = Len(Xiao) To 1 Step -1
            chrNum = Mid(Xiao, I, 1)
            If chrNum <> 0 Then
                Num2Chi = Mid(c2, I, 1) & Num2Chi
                Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
            End If
        Next I
    End If
    
    K = 0
    If Val(Zheng) <> 0 Then
        Num2Chi = "元" & Num2Chi
        For I = Len(Zheng) To 1 Step -1
            If (Len(Zheng) - I) = 4 Then
                Num2Chi = "万" & Num2Chi
            ElseIf (Len(Zheng) - I) = 8 Then
                Num2Chi = "亿" & Num2Chi
            ElseIf (Len(Zheng) - I) = 12 Then
                Num2Chi = "万" & Num2Chi
            End If
            chrNum = Mid(Zheng, I, 1)
            If chrNum <> 0 Then
                If I = Len(Zheng) Then
                    Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
                Else
                    If (Len(Zheng) - I) <> 4 And (Len(Zheng) - I) <> 8 And (Len(Zheng) - I) <> 12 Then
                        Num2Chi = Mid(c1, (Len(c1) - K), 1) & Num2Chi
                    End If
                    Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
                End If
            Else
                If Mid(Num2Chi, 1, 1) <> "元" And Mid(Num2Chi, 1, 1) <> "万" And Mid(Num2Chi, 1, 1) <> "亿" Then
                    If Mid(Num2Chi, 1, 1) <> "零" Then
                        Num2Chi = "零" & Num2Chi
                    End If
                End If
           End If
            K = K + 1
        Next I
    End If
    If Right(Trim(Num2Chi), 1) <> "分" Then
        Num2Chi = Num2Chi & "整"
    End If
End FunctionPrivate Function CNulls( _
    ByVal v As Variant, _
    ByVal DefaultValue As Variant) As Variant
    
    ' determine if it is "Null"
    Dim bIsNull As Boolean, t As VbVarType
    t = VarType(v)
    If t = vbObject Then
        bIsNull = v Is Nothing
    Else
        bIsNull = IsEmpty(v) Or IsNull(v)
        If t = vbString Then
            bIsNull = bIsNull Or v = vbNullString
        ElseIf t > vbArray Then
            bIsNull = bIsNull Or (LBound(v) = UBound(v))
        End If
    End If
    
    If bIsNull Then
        If Not IsMissing(DefaultValue) Then
            CNulls = DefaultValue
        Else
            Select Case t
            Case vbString
                CNulls = vbNullString
            Case vbLong             ' list seprately for getting more performance
                CNulls = 0
            Case vbInteger
                CNulls = 0
            Case vbDouble
                CNulls = 0
            Case vbBoolean
                CNulls = False
            Case vbByte, vbCurrency, vbDecimal, vbDouble, _
                 vbError, vbSingle
                CNulls = 0
            Case vbDate
                CNulls = Now
            Case Else
                CNulls = Null
            End Select
        End If
    Else
        CNulls = v
    End If
End Function
复制别人的用起来还不错

Answer 2

' 名称： CCh
'        得到一位数字 N1 的汉字大写
'ToMoney=0,转换为金额样式,=1,转换为数字大写
Private Function Cch(ByVal N1&, ByVal ToMoney&, Optional ByVal CchStr$) As String
    Select Case ToMoney
        Case 0
            CchStr = "零壹贰叁肆伍陆柒捌玖"
        Case 1
            CchStr = "零一二三四五六七八九"
    End Select
    On Error Resume Next
    Cch = Mid(CchStr, N1 + 1, 1)
End Function'名称： ChMoney
'       得到金额或数字 N1 的汉字大写
'       最大为 千亿位
'       O 返回 ""
Public Function ChMoney(ByVal N1, Optional ByVal ToMoney As Boolean = True) As String
Dim tMoney As String
Dim tn '小数位置
Dim S(4) As String, i&, J&, T1$
Dim Cch1$, Cch2&, St1$
Cch1 = "拾佰仟"
Cch2 = IIf(ToMoney, 0, 1)N1 = IIf(ToMoney, Round(Val(N1) + 0.001, 2), Val(N1))
If N1 = 0 Then
    ChMoney = ""
    Exit Function
End If
If N1 < 0 Then
    ChMoney = "负" + ChMoney(Abs(N1))
    Exit Function
End If
tMoney = Trim(Str(N1))
tn = InStr(tMoney, ".")  '小数位置S(0) = ""
If tn <> 0 Then
    St1 = Right(tMoney, Len(tMoney) - tn)
    If ToMoney Then
        If St1 <> "" Then
            T1 = Left(St1, 1)
            St1 = Right(St1, Len(St1) - 1)
            If T1 <> "0" Then
                S(0) = S(0) + Cch(Val(T1), Cch2) + "角"
            End If
            If St1 <> "" Then
                T1 = Left(St1, 1)
                S(0) = S(0) + Cch(Val(T1), Cch2) + "分"
            End If
        End If
    Else
        For i = 1 To Len(St1)
            S(0) = S(0) & Cch(Val(Mid(St1, i, 1)), Cch2)
        Next i
    End If
    St1 = Left(tMoney, tn - 1)
Else
    St1 = tMoney
End IfFor i = 1 To 3
    S(i) = ""
    If St1 <> "" Then
      T1 = Right(St1, 1)
      St1 = Left(St1, Len(St1) - 1)
      S(i) = Cch(Val(T1), Cch2) + S(i)
    End If
    For J = 1 To 3
        If St1 <> "" Then
          T1 = Right(St1, 1)
          St1 = Left(St1, Len(St1) - 1)
          If T1 <> "0" Then
            S(i) = Cch(Val(T1), Cch2) + Mid(Cch1, J, 1) + S(i)
          Else
            If Left(S(i), 1) <> "零" Then S(i) = "零" + S(i)
          End If
        End If
    Next J
    If Right(S(i), 1) = "零" Then S(i) = Left(S(i), Len(S(i)) - 1)
    If i > 1 And Len(S(i)) > 0 Then
        If Right(S(i), 1) = "零" Then S(i) = Left(S(i), Len(S(i)) - 1)
        S(i) = S(i) & IIf(i = 2, "万", "亿")
    End If
Next iIf Left(S(3), 1) = "零" Then S(3) = Mid(S(3), 2)
S(1) = S(3) & S(2) & S(1)
If S(1) = "" Then
    ChMoney = IIf(ToMoney, S(0), "零." & S(0))
Else
    ChMoney = IIf(S(0) = "" And Not ToMoney, S(1), S(1) & IIf(ToMoney, "元", ".") & S(0))
End IfEnd Function

Answer 3

我自己写的，可能还有些问题：-）'阿拉伯数字转换为汉字大写数字
Private Function GetCapitalTotle(ByVal tmpStr As String)
Dim Pos As Integer
Dim tChar As String
Dim tLen As Integer
Dim CapStr As String
Dim IntString As String
Dim j As IntegerIntString = Left(tmpStr, InStr(tmpStr, ".") - 1)
tLen = Len(IntString)For i = 1 To tLen
 tChar = Left(IntString, 1)
 CapStr = CapStr & GetCapChar(tChar)
 
 If Right(CapStr, 1) <> "零" Then
  j = Len(IntString)
  CapStr = CapStr & GetCapUnit(j)
 End If
 
 If Right(CapStr, 2) = "零零" Then
  CapStr = Left(CapStr, Len(CapStr) - 1)
 End If
 
 IntString = Mid(IntString, 2)
 If Val(IntString) = 0 Then
  If Right(CapStr, 1) = "零" Then CapStr = Left(CapStr, Len(CapStr) - 1)
  CapStr = CapStr & "元"
  Exit For
 End If
NexttChar = Mid(tmpStr, InStr(tmpStr, ".") + 1)
If tChar <> 0 Then
  CapStr = CapStr & GetCapChar(Left(tChar, 1)) & "角"
  If Right(tChar, 1) <> 0 Then
   CapStr = CapStr & GetCapChar(Right(tChar, 1)) & "分"
  End If
End IfGetCapitalTotle = CapStr & "整"
 
End FunctionPrivate Function GetCapChar(ByVal tmpchar As String) Select Case tmpchar
 Case 1
      GetCapChar = "壹"
 Case 2
      GetCapChar = "贰"
 Case 3
      GetCapChar = "叁"
 Case 4
      GetCapChar = "肆"
 Case 5
      GetCapChar = "伍"
 Case 6
      GetCapChar = "陆"
 Case 7
      GetCapChar = "柒"
 Case 8
      GetCapChar = "捌"
 Case 9
      GetCapChar = "玖"
 Case 0
      GetCapChar = "零"
 End SelectEnd FunctionPrivate Function GetCapUnit(ByVal t As Integer)
 
 Select Case t
 Case 5
      GetCapUnit = "万"
 Case 4
      GetCapUnit = "仟"
 Case 3
      GetCapUnit = "佰"
 Case 2
      GetCapUnit = "拾"
 End Select
 
End Function

Answer 4

'*********************************************************
'* 名称：nNumber2Chinese
'* 功能：数值转换为人民币(汉字)
'* 用法：nNumber2Chinese(数值)
'*********************************************************
Public Function Num2Chi(txtJE As Double) As String
    Dim I, K As Integer
    Dim NC, nd, ka, chrNum, strZheng As String
    Dim c1, c2, c3 As String
    Dim K1 As Integer
    Dim Zheng As String
    Dim Xiao As String
    NC = Trim(Format(txtJE, "##0.00"))
    c1 = "仟佰拾万仟佰拾亿仟佰拾万仟佰拾元"
    c2 = "角分"
    c3 = "玖捌柒陆伍肆叁贰壹"
    If NC = 0 Then
        Num2Chi = "零元整"
        Exit Function
    End If
    Num2Chi = ""
    Zheng = Mid(NC, 1, (Len(NC) - 3))
    Xiao = Mid(NC, (Len(Zheng) + 2))
    If Val(Xiao) <> 0 Then
        For I = Len(Xiao) To 1 Step -1
            chrNum = Mid(Xiao, I, 1)
            If chrNum <> 0 Then
                Num2Chi = Mid(c2, I, 1) & Num2Chi
                Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
            End If
        Next I
    End If
    
    K = 0
    If Val(Zheng) <> 0 Then
        Num2Chi = "元" & Num2Chi
        For I = Len(Zheng) To 1 Step -1
            If (Len(Zheng) - I) = 4 Then
                Num2Chi = "万" & Num2Chi
            ElseIf (Len(Zheng) - I) = 8 Then
                Num2Chi = "亿" & Num2Chi
            ElseIf (Len(Zheng) - I) = 12 Then
                Num2Chi = "万" & Num2Chi
            End If
            chrNum = Mid(Zheng, I, 1)
            If chrNum <> 0 Then
                If I = Len(Zheng) Then
                    Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
                Else
                    If (Len(Zheng) - I) <> 4 And (Len(Zheng) - I) <> 8 And (Len(Zheng) - I) <> 12 Then
                        Num2Chi = Mid(c1, (Len(c1) - K), 1) & Num2Chi
                    End If
                    Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
                End If
            Else
                If Mid(Num2Chi, 1, 1) <> "元" And Mid(Num2Chi, 1, 1) <> "万" And Mid(Num2Chi, 1, 1) <> "亿" Then
                    If Mid(Num2Chi, 1, 1) <> "零" Then
                        Num2Chi = "零" & Num2Chi
                    End If
                End If
           End If
            K = K + 1
        Next I
    End If
    If Right(Trim(Num2Chi), 1) <> "分" Then
        Num2Chi = Num2Chi & "整"
    End If
End Function