VB6 人民币小写转大写转换

 

  Option   Explicit  

Public   Function  NumberToCharacter(number  As   String )  As   String  
' 完成转换的主函数 
Dim  Pos_Point  As   Long   ' 记录小数点的位置 
Dim  curNum  As   String   ' 记录当前处理的数字 
Dim  zhengshu  As   String   ' 记录整数部分 
Dim  shuduan  As   String   ' 截取某一个数据段 
' 检索小数点的位置 
Pos_Point  =   InStr (number,  " . " ) 
' 处理小数部分 
If  Pos_Point  =   0   Then  
' 没有小数点，将小数点设置在最末尾 
Pos_Point  =   Len (number) 
ElseIf   Len (number)  =  Pos_Point  Then  
' 以小数点结尾，不作处理 
ElseIf   Len (number)  =  Pos_Point  +   1   Then  
' 一位小数，直接翻译为角 
curNum  =   Right (number,  1 ) 
NumberToCharacter  =  NumToChr(curNum)  &   " 角 "  
ElseIf   Len (number)  =  Pos_Point  +   2   Then  
' 取第一位 
curNum  =   Right (number,  1 ) 
' 若第一位为零，则不作处理，否则译为“角” 
If  curNum  <>   " 0 "   Then  
NumberToCharacter  =  NumToChr(curNum)  &   " 分 "  
End   If  
' 取第二位 
curNum  =   Left ( Right (number,  2 ),  1 ) 
' 若第二为零，不作处理，否则译为“分” 
If  curNum  <>   " 0 "   Then  
NumberToCharacter  =  NumToChr(curNum)  &   " 角 "   &  NumberToCharacter 
End   If  
End   If  

' 处理整数 
zhengshu  =   ""  
If  Pos_Point  >   14   Then  
' 大于 9999999999999 的数据不转换 
MsgBox   " 该数据无法转换 " , vbOKOnly  +  vbInformation,  " 金额转换 "  
Exit Function  
ElseIf  Pos_Point  >   9   Then  
zhengshu  =   " 亿 "  
' 亿位以上的部分 
shuduan  =   Left (number, Pos_Point  -   9 ) 
zhengshu  =  shuduantoCharacter(shuduan)  &  zhengshu 
' 万位以上的部分 
shuduan  =   Right ( Left (number, Pos_Point  -   5 ),  4 ) 
zhengshu  =  zhengshu  &  shuduantoCharacter(shuduan)  &   " 万 "  
' 万位以下部分 
shuduan  =   Right ( Left (number, Pos_Point  -   1 ),  4 ) 
zhengshu  =  zhengshu  &  shuduantoCharacter(shuduan)  &   " 圆 "  
ElseIf  Pos_Point  >   5   Then  
' 万位以上的部分 
shuduan  =   Right ( Left (number, Pos_Point  -   5 ),  4 ) 
zhengshu  =  zhengshu  &  shuduantoCharacter(shuduan)  &   " 万 "  
' 万位以下部分 
shuduan  =   Right ( Left (number, Pos_Point  -   1 ),  4 ) 
zhengshu  =  zhengshu  &  shuduantoCharacter(shuduan)  &   " 圆 "  
Else  
' 万位以下 
shuduan  =   Right ( Left (number, Pos_Point  -   1 ),  4 ) 
zhengshu  =  zhengshu  &  shuduantoCharacter(shuduan)  &   " 圆 "  
End   If  
NumberToCharacter  =  zhengshu  &  NumberToCharacter 
' 输入为“0”，特殊处理 
If  NumberToCharacter  =   " 圆 "   Then  
NumberToCharacter  =   " 零圆 "  
End   If  

End Function  

Public   Function  NumToChr(num  As   String )  As   String  
' 数字转化为对应的中文 
Select   Case  num 
Case   " 1 "  
NumToChr  =   " 壹 "  
Case   " 2 "  
NumToChr  =   " 贰 "  
Case   " 3 "  
NumToChr  =   " 参 "  
Case   " 4 "  
NumToChr  =   " 肆 "  
Case   " 5 "  
NumToChr  =   " 伍 "  
Case   " 6 "  
NumToChr  =   " 陆 "  
Case   " 7 "  
NumToChr  =   " 柒 "  
Case   " 8 "  
NumToChr  =   " 捌 "  
Case   " 9 "  
NumToChr  =   " 玖 "  
Case   " 0 "  
NumToChr  =   " 零 "  
End   Select  
End Function  

' 对分节后的每一节数据进行翻译， 
' 例如: 1234512341234被分为12345，1234，1234 
Public   Function  shuduantoCharacter(duan  As   String )  As   String  
Dim  curNum  As   String  
Dim  answer  As   String  
answer  =   ""  
If   Len (duan)  =   5   Then  
' 有万位 
answer  =  NumToChr( Left (duan,  1 ))  &   " 万 "  
' 千位 
curNum  =   Right ( Left (duan,  2 ),  1 ) 
If  curNum  <>   " 0 "   Then  
answer  =  answer  &  NumToChr(curNum)  &   " 仟 "  
Else  
answer  =  answer  &   " 零 "  
End   If  
' 百位 
curNum  =   Right ( Left (duan,  3 ),  1 ) 
If  curNum  <>   " 0 "   Then  
answer  =  answer  &  NumToChr(curNum)  &   " 佰 "  
Else  
If   Right (answer,  1 )  <>   " 零 "   Then  
answer  =  answer  &   " 零 "  
End   If  
End   If  
' 十位 
curNum  =   Right ( Left (duan,  4 ),  1 ) 
If  curNum  <>   " 0 "   Then  
answer  =  answer  &  NumToChr(curNum)  &   " 拾 "  
Else  
If   Right (answer,  1 )  <>   " 零 "   Then  
answer  =  answer  &   " 零 "  
End   If  
End   If  
' 个位 
curNum  =   Right (duan,  1 ) 
If  curNum  <>   " 0 "   Then  
answer  =  answer  &  NumToChr(curNum) 
Else  
If   Right (answer,  1 )  =   " 零 "   Then  
answer  =   Left (answer,  Len (answer)  -   1 ) 
End   If  
End   If  
ElseIf   Len (duan)  =   4   Then  
' 有千位 
answer  =  NumToChr( Left (duan,  1 ))  &   " 仟 "  
' 百位 
curNum  =   Left ( Right (duan,  3 ),  1 ) 
If  curNum  <>   " 0 "   Then  
answer  =  answer  &  NumToChr(curNum)  &   " 佰 "  
Else  
If   Right (answer,  1 )  <>   " 零 "   Then  
answer  =  answer  &   " 零 "  
End   If  
End   If  
' 十位 
curNum  =   Left ( Right (duan,  2 ),  1 ) 
If  curNum  <>   " 0 "   Then  
answer  =  answer  &  NumToChr(curNum)  &   " 拾 "  
Else  
If   Right (answer,  1 )  <>   " 零 "   Then  
answer  =  answer  &   " 零 "  
End   If  
End   If  
' 个位 
curNum  =   Right (duan,  1 ) 
If  curNum  <>   " 0 "   Then  
answer  =  answer  &  NumToChr(curNum) 
Else  
If   Right (answer,  1 )  =   " 零 "   Then  
answer  =   Left (answer,  Len (answer)  -   1 ) 
End   If  
End   If  
ElseIf   Len (duan)  =   3   Then  
' 有百位 
answer  =  NumToChr( Left (duan,  1 ))  &   " 佰 "  
' 十位 
curNum  =   Left ( Right (duan,  2 ),  1 ) 
If  curNum  <>   " 0 "   Then  
answer  =  answer  &  NumToChr(curNum)  &   " 拾 "  
Else  
If   Right (answer,  1 )  <>   " 零 "   Then  
answer  =  answer  &   " 零 "  
End   If  
End   If  
' 个位 
curNum  =   Right (duan,  1 ) 
If  curNum  <>   " 0 "   Then  
answer  =  answer  &  NumToChr(curNum) 
Else  
If   Right (answer,  1 )  =   " 零 "   Then  
answer  =   Left (answer,  Len (answer)  -   1 ) 
End   If  
End   If  
ElseIf   Len (duan)  =   2   Then  
' 有十位 
answer  =  NumToChr( Left (duan,  1 ))  &   " 拾 "  
' 个位 
curNum  =   Right (duan,  1 ) 
If  curNum  <>   " 0 "   Then  
answer  =  answer  &  NumToChr(curNum) 
Else  
If   Right (answer,  1 )  =   " 零 "   Then  
answer  =   Left (answer,  Len (answer)  -   1 ) 
End   If  
End   If  
ElseIf   Len (duan)  =   1   Then  
' 有个位 
answer  =  NumToChr( Left (duan,  1 )) 
End   If  
shuduantoCharacter  =  answer 

End Function