欢迎光临本社区!请 [登录][注册]
搜索
广播台

24

主题

0

听众

219

积分
  • 2学前班

该用户从未签到

UID
56468
帖子
0
相册
0
分享到:
发表于 2009-7-29 11:17:49 |显示全部楼层
马上注册,结交更多好友,享用更多功能,让你轻松玩转西安论坛。 立即注册  已有账号?点击登录   关闭
Public Function AtoC(a As Currency) As String
'阐明:本函数合适于万亿以下的货币转换,容许A的值是最多两位小数
'定义两个字符串,此处汉字与数字均按一位盘算
Dim String1 As String '如下定义
Dim String2 As String '如下定义
Dim String3 As String '从原A值中取出的值
Dim i As Integer '循环变量
Dim j As Integer 'A的值乘以100的字符串长度
Dim temp As Long  '临时变量
Dim Ch1 As String '数字的汉语读法
Dim Ch2 As String '数字位的汉字读法
Dim nZero As Integer '用来盘算持续的非零数是几个
   
String1 = "零壹贰叁肆伍陆柒捌玖"
String2 = "万仟佰拾亿仟佰拾万仟佰拾元角分"
If InStr(1, CStr(a * 100), ".") <> 0 Then
temp = CLng(a * 100)
a = CCur(temp / 100)
End If
   
j = Len(CStr(a * 100))
String2 = Right(String2, j) '取出对应位数的STRING2的值
   
For i = 1 To j
String3 = Mid(a * 100, i, 1) '取出需转换的某一位的值
If String3 <> "0" Then
Ch1 = Mid(String1, Val(String3) + 1, 1)
Ch2 = Mid(String2, i, 1)
nZero = nZero + 1 '表现本位不为零
Else
If nZero <> 0 Or i = j - 9 Or i = j - 5 Or i = j - 1 Then
If Right(AtoC, 1) = "零" Then AtoC = Left(AtoC, Len(AtoC) - 1)
Ch1 = "零"
Else
Ch1 = ""
End If
   
'如果转换的数值须要扩展,那么需篡改以下表达式 I 的值。
If i = j - 10 Then
Ch2 = "亿"
ElseIf i = j - 6 Then
Ch2 = "万"
ElseIf i = j - 2 Then
Ch2 = "元"
ElseIf i = j Then
Ch2 = "整"
Else
Ch2 = ""
End If
nZero = 0
End If
   
AtoC = AtoC & Ch1 & Ch2
Next i
   
'最后将过剩的零去掉
   
AtoC = Replace(AtoC, "零元", "元")
AtoC = Replace(AtoC, "零万", "万")
AtoC = Replace(AtoC, "零亿", "亿")
AtoC = Replace(AtoC, "零整", "整")
'AtoC = Replace(AtoC, "元零", "元零角")
End Function
Public Function GetRS(ByVal strQuery As String) As ADODB.Recordset
    Dim rs As New ADODB.Recordset
    Dim conn As New ADODB.Connection
    On Error GoTo GetRS_Error
    Set conn = CurrentProject.Connection
    rs.Open Trim$(strQuery), conn, adOpenKeyset, adLockOptimistic
    Set GetRS = rs
GetRS_Exit:
    Set rs = Nothing
    Set conn = Nothing
    Exit Function
GetRS_Error:
    MsgBox (Err.Description)
    Resume GetRS_Exit
End Function
Public Sub RunSQL(ByVal strCmd As String)
    Dim conn As New ADODB.Connection
    On Error GoTo ExecuteSQL_Error
    Set conn = CurrentProject.Connection
    conn.Execute Trim$(strCmd)
ExecuteSQL_Exit:
    Set conn = Nothing
    Exit Sub
ExecuteSQL_Error:
    MsgBox (Err.Description)
    Resume ExecuteSQL_Exit
End Sub
Public Sub EnterToTab(Keyasc As String)
    If Keyase = 13 Then
        SendKeys "{TAB}"
    End If
End Sub
Function Gtrim(Str As String) As String
Str = Replace(Str, " ", "") '替换半角空格
Gtrim = Replace(Str, Chr(-24159), "") '替换全角空格
End Function

帖子标签: amwayindia, amwayindia

使用高级模式(可批量传图、插入视频等)快速回复

您需要登录后才可以回帖 登录 | 注册西安论坛

  Ctrl + Enter 快速发布 

发帖时请遵守我国法律,网站会将有关你发帖内容、时间以及发帖IP地址等记录保留,只要接到合法请求,即会将信息提供给有关政府机构。

广播台


找客服

回顶部