cmoney.bas

适合乡镇供电所使用电费处理系统v3 软件

Attribute VB_Name = "Cmoney"
Option Explicit

' 名称： 数字转大写
'        得到一位数字 N1 的汉字大写
'        0 返回 ""
Private Function CCh(N1) As String
Select Case N1
  Case 0
    CCh = "零"
  Case 1
    CCh = "壹"
  Case 2
    CCh = "贰"
  Case 3
    CCh = "叁"
  Case 4
    CCh = "肆"
  Case 5
    CCh = "伍"
  Case 6
    CCh = "陆"
  Case 7
    CCh = "柒"
  Case 8
    CCh = "捌"
  Case 9
    CCh = "玖"
End Select
End Function

Private Function CH(N1) As String
Select Case N1
  Case 0
    CH = "0"
  Case 1
    CH = "1"
  Case 2
    CH = "2"
  Case 3
    CH = "3"
  Case 4
    CH = "4"
  Case 5
    CH = "5"
  Case 6
    CH = "6"
  Case 7
    CH = "7"
  Case 8
    CH = "8"
  Case 9
    CH = "9"
End Select
End Function


'名称： ChMoneyY
'       得到数字 N1 的汉字大写
'       最大为 千万位
'       O 返回 ""
Public Function ChMoneyY(N1) As String
Dim tMoney As String
Dim lMoney As String
Dim tn
Dim s1 As String '临时STRING 小数部分
Dim s2 As String '
Dim ST1 As String
Dim t1 As String
Dim s3 As String


If N1 = 0 Then
  ChMoneyY = " "
  Exit Function
End If
If N1 < 0 Then
  ChMoneyY = "负" + ChMoney(Abs(N1))
  Exit Function
End If
tMoney = Trim(Str(N1))
tn = InStr(tMoney, ".")
s1 = ""

If tn <> 0 Then
  ST1 = Right(tMoney, Len(tMoney) - tn)
  If ST1 <> "" Then
    t1 = Left(ST1, 1)
    ST1 = Right(ST1, Len(ST1) - 1)
    If t1 <> "0" Then
      s1 = s1 + CCh(Val(t1)) + "角"
    End If
    If ST1 <> "" Then
     t1 = Left(ST1, 1)
     s1 = s1 + CCh(Val(t1)) + "分"
    End If
  End If
  ST1 = Left(tMoney, tn - 1)
Else
  ST1 = tMoney
End If


's1 = "元" + s1
s2 = ""
If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  s2 = CCh(Val(t1)) + s2
End If

If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
    s2 = CCh(Val(t1)) + "拾" + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
    s2 = CCh(Val(t1)) + "佰" + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
  s2 = CCh(Val(t1)) + "仟" + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

s3 = ""
If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  s3 = CCh(Val(t1)) + s3
End If


If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
     s3 = CCh(Val(t1)) + "拾" + s3
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If
If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
   s3 = CCh(Val(t1)) + "佰" + s3
  Else
   If Left(s3, 1) <> "零" Then s3 = "零" + s3
  End If
End If

If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
  s3 = CCh(Val(t1)) + "仟" + s3
  End If
End If
If Right(s2, 1) = "零" Then s2 = Left(s2, Len(s2) - 1)
If Len(s3) > 0 Then
  If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
  s3 = s3 & "万"
End If
ChMoneyY = s3 & s2 & "元" & s1
End Function


Public Function ChMoney(N1) As String
Dim tMoney As String
Dim lMoney As String
Dim tn
Dim s1 As String '临时STRING 小数部分
Dim s2 As String '
Dim ST1 As String
Dim t1 As String
Dim s3 As String

On Error GoTo Wjs
If N1 = 0 Then
  ChMoney = " "
  Exit Function
End If
If N1 < 0 Then
  ChMoney = "负" + ChMoney(Abs(N1))
  Exit Function
End If
tMoney = Trim(Format(Str(N1), "0.00")) & " "
tn = InStr(tMoney, ".")
s1 = ""

If tn <> 0 Then
  ST1 = Right(tMoney, Len(tMoney) - tn)
  If ST1 <> "" Then
    t1 = Left(ST1, 1)
    ST1 = Right(ST1, Len(ST1) - 1)
    If t1 <> "0" Then
      s1 = s1 + CCh(Val(t1))
    Else
      s1 = s1 + CCh(Val(t1))
    End If
    If ST1 <> "" Then
     t1 = Left(ST1, 1)
     s1 = s1 + CCh(Val(t1))
    End If
  End If
  ST1 = Left(tMoney, tn - 1)
Else
  ST1 = tMoney
End If


's1 = "元" + s1
s2 = ""
If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  s2 = CCh(Val(t1)) + s2
End If

If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
    s2 = CCh(Val(t1)) + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
    s2 = CCh(Val(t1)) + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
  s2 = CCh(Val(t1)) + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

s3 = ""
If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  s3 = CCh(Val(t1)) + s3
End If


If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
  s3 = CCh(Val(t1)) + s3
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If
If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
  s3 = CCh(Val(t1)) + s3
  Else
   If Left(s3, 1) <> "零" Then s3 = "零" + s3
  End If
End If

If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
  s3 = CCh(Val(t1)) + s3
  End If
End If
If Len(s3) > 0 Then
  If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
  s3 = s3
End If
ChMoney = s3 & s2 & IIf(s1 = "", "零零", s1)

Exit Function

Wjs:
   MsgBox "电费有误，未计算！"
   Resume Next
End Function


Public Function ChM(N1) As String
Dim tMoney As String
Dim lMoney As String
Dim tn
Dim s1 As String '临时STRING 小数部分
Dim s2 As String '
Dim ST1 As String
Dim t1 As String
Dim s3 As String

On Error GoTo Wjs
If N1 = 0 Then
  ChM = " "
  Exit Function
End If
If N1 < 0 Then
  ChM = "负" + ChM(Abs(N1))
  Exit Function
End If
tMoney = Trim(Format(Str(N1), "0.00")) & " "
tn = InStr(tMoney, ".")
s1 = ""

If tn <> 0 Then
  ST1 = Right(tMoney, Len(tMoney) - tn)
  If ST1 <> "" Then
    t1 = Left(ST1, 1)
    ST1 = Right(ST1, Len(ST1) - 1)
    If t1 <> "0" Then
      s1 = s1 + CH(Val(t1))
    Else
      s1 = s1 + CH(Val(t1))
    End If
    If ST1 <> "" Then
     t1 = Left(ST1, 1)
     s1 = s1 + CH(Val(t1))
    End If
  End If
  ST1 = Left(tMoney, tn - 1)
Else
  ST1 = tMoney
End If


's1 = "元" + s1
s2 = ""
If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  s2 = CH(Val(t1)) + s2
End If

If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
    s2 = CH(Val(t1)) + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
    s2 = CH(Val(t1)) + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
  s2 = CH(Val(t1)) + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

s3 = ""
If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  s3 = CH(Val(t1)) + s3
End If


If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
  s3 = CH(Val(t1)) + s3
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If
If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
  s3 = CH(Val(t1)) + s3
  Else
   If Left(s3, 1) <> "零" Then s3 = "零" + s3
  End If
End If

If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
  s3 = CH(Val(t1)) + s3
  End If
End If
If Len(s3) > 0 Then
  If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
  s3 = s3
End If
ChM = s3 & s2 & IIf(s1 = "", "零零", s1)

Exit Function

Wjs:
   MsgBox "电费有误，未计算！"
   Resume Next
End Function