VB常用功能函数小结

********************************************************************

将日期转换成中文：二零零七年六月二十五日 十点二十七分五十六秒

Function CDateToString(ByVal d As Date) As String

Dim s As String
Dim tmp() As String
Dim i As Integer
Dim arr As Variant

s = Format(d, "yyyy-m-d h:m:s")

s = Replace(s, "-", Chr(32))
s = Replace(s, ":", Chr(32))
tmp = Split(s, Chr(32))
For i = 1 To UBound(tmp)
tmp(i) = Switch( _
Val(tmp(i)) < 10, tmp(i), _
Val(tmp(i)) = 10, "十", _
Val(tmp(i)) > 10 And Val(tmp(i)) < 20, "十" & Right(tmp(i), 1), _
Val(tmp(i)) Mod 10 = 0, Left(tmp(i), 1) & "十", _
Val(tmp(i)) > 20, Left(tmp(i), 1) & "十" & Right(tmp(i), 1))
Next
arr = Array("年", "月", "日 ", "点", "分", "秒")
s = vbNullString
For i = 0 To UBound(arr)
s = s & tmp(i) & arr(i)
Next

s = Replace(s, "0", "零")
s = Replace(s, "1", "一")
s = Replace(s, "2", "二")
s = Replace(s, "3", "三")
s = Replace(s, "4", "四")
s = Replace(s, "5", "五")
s = Replace(s, "6", "六")
s = Replace(s, "7", "七")
s = Replace(s, "8", "八")
s = Replace(s, "9", "九")

CDateToString = s

End Function

**********************************************

将金额转换为大写中文

**********************************************

Private Function CChinese(StrEng As String) As String
If Not IsNumeric(StrEng) Or StrEng Like "*-*" Then
If Trim(StrEng) <> "" Then MsgBox "数字格式有误", vbCritical + vbOKOnly, "错误"
CChinese = "": Exit Function
End If
Dim intLen As Integer, intCounter As Integer
Dim strCh As String, strTempCh As String
Dim strSeqCh1 As String, strSeqCh2 As String
Dim strEng2Ch As String
strEng2Ch = "零壹贰叁肆伍陆柒捌玖"
strSeqCh1 = " 拾佰仟 拾佰仟 拾佰仟 拾佰仟"
strSeqCh2 = " 万亿兆"
StrEng = CStr(Format(StrEng, "##0.00"))
intLen = IIf(InStr(StrEng, ".") = 0, Len(StrEng), InStr(StrEng, ".") - 1)
For intCounter = 1 To intLen
strTempCh = Mid(strEng2Ch, Val(Mid(StrEng, intCounter, 1)) + 1, 1)
If strTempCh = "零" And intLen <> 1 Then
If Mid(StrEng, intCounter + 1, 1) = "0" Or (intLen - intCounter + 1) Mod 4 = 1 Then
strTempCh = ""
End If
Else
strTempCh = strTempCh & Trim(Mid(strSeqCh1, intLen - intCounter + 1, 1))
End If
If (intLen - intCounter + 1) Mod 4 = 1 Then
strTempCh = strTempCh & Mid(strSeqCh2, (intLen - intCounter + 1) / 4 + 1, 1)
If intCounter > 3 Then
If Mid(StrEng, intCounter - 3, 4) = "0000" Then strTempCh = Left(strTempCh, Len(strTempCh) - 1)
End If
End If
strCh = strCh & Trim(strTempCh)
Next

If InStr(StrEng, ".") = 0 Then
CChinese = strCh
Exit Function
Else
intCounter = InStr(StrEng, ".") + 1
If Val(Mid(StrEng, intCounter, 1)) = 0 And Val(Mid(StrEng, intCounter + 1, 1)) = 0 Then
CChinese = strCh
Exit Function
Else
strCh = strCh & "点"
For intCounter = InStr(StrEng, ".") + 1 To Len(StrEng)
strCh = strCh & Mid(strEng2Ch, Val(Mid(StrEng, intCounter, 1)) + 1, 1)
Next intCounter
CChinese = strCh
End If
End If
End Function

*********************************************

文本框中只能输入汉字

*********************************************

Private Sub Text1_KeyPress(KeyAscii As Integer)

If KeyAscii > 0 Then KeyAscii = 0

Select Case KeyAscii
Case -23632 To -23623, -23615 To -23590, -23583 To -23558
KeyAscii = 0
End Select

End Sub