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