实现日期大写显示

tmtony

引贴
实现日期大写显示，显示效果 ： 二〇〇二年十月四日
Function Date2Chinese(iDate)
      Dim num(10)
      Dim iYear
      Dim iMonth
      Dim iDay

      num(0) = "〇"
      num(1) = "一"
      num(2) = "二"
      num(3) = "三"
      num(4) = "四"
      num(5) = "五"
      num(6) = "六"
      num(7) = "七"
      num(8) = "八"
      num(9) = "九"

      iYear = Year(iDate)
      iMonth = Month(iDate)
      iDay = Day(iDate)
      Date2Chinese = num(iYear \ 1000) + _
            num((iYear \ 100) Mod 10) + num((iYear _
            \ 10) Mod 10) + num(iYear Mod _
            10) + "年"
      If iMonth >= 10 Then
            If iMonth = 10 Then
                  Date2Chinese = Date2Chinese + _
                  "十" + "月"
            Else
                  Date2Chinese = Date2Chinese + _
                  "十" + num(iMonth Mod 10) + "月"
            End If
      Else
            Date2Chinese = Date2Chinese + _
                  num(iMonth Mod 10) + "月"
      End If
      If iDay >= 10 Then
            If iDay = 10 Then
                  Date2Chinese = Date2Chinese + _
                  "十" + "日"
            ElseIf iDay = 20 Or iDay = 30 Then
                  Date2Chinese = Date2Chinese + _
                  num(iDay \ 10) + "十" + "日"
            ElseIf iDay > 20 Then
                  Date2Chinese = Date2Chinese + _
                  num(iDay \ 10) + "十" + _
                  num(iDay Mod 10) + "日"
            Else
                 Date2Chinese = Date2Chinese + _
                 "十" + num(iDay Mod 10) + "日"
            End If
      Else
            Date2Chinese = Date2Chinese + _
            num(iDay Mod 10) + "日"
      End If
End Function
可自己改改适合自己的需要

HG

呵呵，站長真仔細呀，把判斷十以上的月份處理都寫上了。可有的時間，人家不須要您搞的這樣復雜呀。
http://www.office-cn.net/bbs/dispbbs.asp?boardID=2&RootID=14523&ID=14523
我作的同你的相比怎樣?

[此贴子已经被HG于2002-10-4 11:51:19编辑过]

Trynew

数字转为大写我用过，日期直接选定显示中文格式不就行了吗？
各位是想练练招吧？程序写的是不错，千万别误导人家喔。

Trynew

对不起，我说错了，这样的转换有些地方还是会用到，虽然我没用过。
HG的例子改成这样好像短一些，还有更短的吗？：
Public Function AAA(number As Variant) As String
Select Case number
      Case 0: AAA = "○"
      Case 1: AAA = "一"
      Case 2: AAA = "二"
      Case 3: AAA = "三"
      Case 4: AAA = "四"
      Case 5: AAA = "五"
      Case 6: AAA = "六"
      Case 7: AAA = "七"
      Case 8: AAA = "八"
      Case 9: AAA = "九"
      Case 10: AAA = "十"
      Case 20: AAA = "二十"
      Case 30: AAA = "三十"
      Case 11 To 31: AAA = AAA(Int(number / 10)) & "十" & AAA(number Mod 10)
   End Select
End Function

Public Function BBB(ChnDate As Variant) As String
    BBB = AAA(Mid(Year(ChnDate), 1, 1)) & AAA(Mid(Year(ChnDate), 2, 1))
    BBB = BBB & AAA(Mid(Year(ChnDate), 3, 1)) & AAA(Mid(Year(ChnDate), 4, 1)) & "年"
    BBB = BBB & AAA(Month(ChnDate)) & "月" & AAA(Day(ChnDate)) & "日"
End Function

运行结果:
Print BBB(Now())
二○○二年十月六日
Print BBB("1982-5-3")
一九八二年五月三日

HG

Type my_case_date
      my_case_year  As String
      my_case_month As String
      my_case_daily As String
End Type

Public Function number_case_hz(my_str_num As String) As String
If IsNull(my_str_num) Then
   MsgBox "錯誤:不可轉入空值", vbOKOnly, "err_info"
Else
   Select Case my_str_num
          Case "0": number_case_hz = "零"
          Case "1": number_case_hz = "壹"
          Case "2": number_case_hz = "貳"
          Case "3": number_case_hz = "毿"
          Case "4": number_case_hz = "肆"
          Case "5": number_case_hz = "伍"
          Case "6": number_case_hz = "陸"
          Case "7": number_case_hz = "柒"
          Case "8": number_case_hz = "捌"
          Case "9": number_case_hz = "玖"
   End Select
End If
End Function
Public Function my_case_date(my_date As Date, my_info_hz As Boolean) As my_case_date

If IsNull(my_date) Or IsNull(my_info_hz) Then
  MsgBox "錯誤:不可轉入空值", vbOKOnly, "err_info"
  Exit Function
End If

Dim str_case_date As String
Dim my_date_year As String
Dim my_date_month As String
Dim my_date_daily As String
Dim my_len As Integer

With my_case_date
.my_case_year = ""
.my_case_month = ""
.my_case_daily = ""
End With

str_case_date = CStr(Format(my_date, "yyyy/mm/dd"))
my_date_year = Left(str_case_date, 4)
my_date_month = Mid(str_case_date, 6, 2)
my_date_daily = Right(str_case_date, 2)

If my_info_hz = fasle Then
  With my_case_date
     .my_case_year = my_date_year
     .my_case_month = my_date_month
     .my_case_daily = my_date_daily
  End With
Else
my_len = 1
While my_len <= 4
  With my_case_date
       .my_case_year = .my_case_year + number_case_hz(Mid(my_date_year, my_len, 1))
  End With
  my_len = my_len + 1
Wend

my_len = 1
If CInt(my_date_month) < 10 Then
  While my_len <= 2
     my_case_date.my_case_month = my_case_date.my_case_month + number_case_hz(Mid(my_date_month, my_len, 1))
     my_len = my_len + 1
  Wend
Else
  If CInt(my_date_month) = 10 Then
     my_case_date.my_case_month = "壹拾"
  Else
    If CInt(my_date_month) = 11 Then
        my_case_date.my_case_month = "壹拾壹"
     Else
       If CInt(my_date_month) = 12 Then
         my_case_date.my_case_month = "壹拾貳"
        End If
    End If
  End If
End If

my_len = 1
If CInt(my_date_daily) < 10 Then
   While my_len <= 2
      my_case_date.my_case_daily = my_case_date.my_case_daily + number_case_hz(Mid(my_date_daily, my_len, 1))
      my_len = my_len + 1
   Wend
Else
  If CInt(my_date_daily) = 10 Then
     my_case_date.my_case_daily = "壹拾"
    Else
      If (CInt(my_date_daily) < 20 And CInt(my_date_daily) > 10) Or (CInt(my_date_daily) < 30 And CInt(my_date_daily) > 20) Then
         my_case_date.my_case_daily = number_case_hz(Left(my_date_daily, 1)) + "拾" + number_case_hz(Right(my_date_daily, 1))
        Else
          If CInt(my_date_daily) = 20 Then
             my_case_date.my_case_daily = "貳拾"
            Else
              If CInt(my_date_daily) = 30 Then
                my_case_date.my_case_daily = "毿拾"
                Else
                  If CInt(my_date_daily) = 31 Then
                    my_case_date.my_case_daily = "毿拾壹"
                   End If
              End If
            End If
        End If
    End If
End If
End If
End Fu
這是最終效果，專門為支票的格式處理過的，而不是一般的通用日期，大寫轉換，現在可以加一個參數，來實現分段輸出數字和漢字格式。