打印时如何将日期字段转换为中文大写。

Question

1.用MaskEdit控件。
2.用代码转换！

Answer 1

这与 Windows 的 "控制面版"->"区域设置"->"长日期样式"有关!
Debug.Print format(date,"long date") 
Debug.Print format(now,"long date") 

Answer 2

1.用DTPicker控件。2.这与 Windows 的 "控制面版"->"区域设置"->"长日期样式"有关!
  Debug.Print format(date,"long date") 
  Debug.Print format(now,"long date") 

Answer 3

format(now,"Long Date") 长日期如：2001年5月9日
format(now,"Short Date") 如：2001-5-9
        |
      此值可改为其它日期类型的变量

Answer 4

Dim DateX As Date
DateX = #11/9/2001#
MsgBox GetChinese(VBA.Year(DateX)) & "年" & GetChinese(VBA.Month(DateX), True) & "月" & GetChinese(VBA.Day(DateX), True) & "日"Public Function GetChinese(sNum As String, Optional IsValue As Boolean) As String
If Not IsValue Then
   Dim ii As Integer
   For ii = 1 To VBA.Len(sNum)
        GetChinese = GetChinese & Choose(Val(Mid(sNum, ii, 1)) + 1, "零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
   Next ii
Else
   If Val(Trim(sNum)) > 0 Then
       Dim sIntD As String
       Dim sDecD As String
       Dim i As Integer
       Dim iCount As Integer
       Dim j As Integer
       Dim iLength As Integer
       Dim lStartPos As Long
       Dim sBIT(4) As String
       Dim sUNIT(3) As String
       'Dim sCents(2) As String
       sBIT(0) = "" '个
       sBIT(1) = "拾" '"十"
       sBIT(2) = "佰"
       sBIT(3) = "仟"
       sUNIT(0) = ""
       sUNIT(1) = "万"
       sUNIT(2) = "亿"
       sUNIT(3) = "兆"
       'sCents(0) = Fen
       'sCents(1) = Jiao
       Dim temp As String
       If InStr(Trim(sNum), ".") > 0 Then
          temp = Left(Trim(sNum), InStr(Trim(sNum), ".") - 1)
       Else
          temp = Trim(sNum)
       End If
       iCount = IIf(Len(temp) Mod 4, Len(Trim(temp)) \ 4 + 1, Len(Trim(temp)) \ 4)
       lStartPos = 1
       For i = iCount To 1 Step -1
           If i = iCount And Len(Trim(temp)) Mod 4 <> 0 Then
              iLength = Len(Trim(temp)) Mod 4
           Else
              iLength = 4
           End If
           sIntD = Mid(Trim(temp), lStartPos, iLength)
           For j = 1 To Len(Trim(sIntD))
               If Val(Mid(sIntD, j, 1)) <> 0 Then
                  GetChinese = GetChinese & Choose(Val(Mid(sIntD, j, 1)), "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖") & sBIT(Len(Trim(sIntD)) - j)
               Else
                  If Val(Mid(sIntD, j + 1, 1)) <> 0 Then
                     GetChinese = GetChinese & "零"
                  End If
               End If
           Next j
           lStartPos = lStartPos + iLength
           If i < iCount Then
              If (Val(Mid(sIntD, Len(Trim(sIntD)), 1)) <> 0 Or Val(Mid(sIntD, Len(Trim(sIntD)) - 1, 1)) <> 0 Or Val(Mid(sIntD, Len(Trim(sIntD)) - 2, 1)) Or Val(Mid(sIntD, Len(Trim(sIntD)) - 3, 1)) <> 0) Then
                 GetChinese = GetChinese & sUNIT(i - 1)
              End If
           Else
              GetChinese = GetChinese & sUNIT(i - 1)
           End If
       Next
       If Len(Trim(GetChinese)) > 0 Then
          GetChinese = GetChinese '& Yuan
       End If
       '小数
       If InStr(1, Trim(sNum), ".") <> 0 Then
          sDecD = Right(sNum, Len(Trim(sNum)) - InStr(1, Trim(sNum), "."))
          For i = 1 To Len(Trim(sDecD))
              If Val(Mid(Trim(sDecD), i, 1)) <> 0 Then
                 GetChinese = GetChinese & Choose(Val(Mid(Trim(sDecD), i, 1)), "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
                 GetChinese = GetChinese '& sCents(2 - i)
                 If i >= 2 Then
                    Exit For
                 End If
              Else
                 If Len(Trim(GetChinese)) > 0 Then
                    GetChinese = GetChinese & "零"
                 End If
              End If
          Next i
       Else
          GetChinese = GetChinese '& "整"
       End If
    Else
       GetChinese = "零" '& Yuan
    End If
End If
End Function
Public Function NtoC(ByVal sNum As String, Optional ByVal Yuan As String = "美圆", Optional ByVal Jiao As String = "美角", Optional ByVal Fen As String = "美分") As String
If Val(Trim(sNum)) > 0 Then
   Dim sIntD, sDecD As String
   Dim i, iCount, j, iLength As Integer
   Dim lStartPos As Long
   Dim sBIT(4), sUNIT(3), sCents(2) As String
   sBIT(0) = "" '个
   sBIT(1) = "拾"
   sBIT(2) = "佰"
   sBIT(3) = "仟"
   sUNIT(0) = ""
   sUNIT(1) = "万"
   sUNIT(2) = "亿"
   sUNIT(3) = "yu"
   sCents(0) = Fen
   sCents(1) = Jiao
   Dim temp As String
   If InStr(Trim(sNum), ".") > 0 Then
      temp = Left(Trim(sNum), InStr(Trim(sNum), ".") - 1)
   Else
      temp = Trim(sNum)
   End If
   iCount = IIf(Len(temp) Mod 4, Len(Trim(temp)) \ 4 + 1, Len(Trim(temp)) \ 4)
   lStartPos = 1
   For i = iCount To 1 Step -1
       If i = iCount And Len(Trim(temp)) Mod 4 <> 0 Then
          iLength = Len(Trim(temp)) Mod 4
       Else
          iLength = 4
       End If
       sIntD = Mid(Trim(temp), lStartPos, iLength)
       For j = 1 To Len(Trim(sIntD))
           If Val(Mid(sIntD, j, 1)) <> 0 Then
              NtoC = NtoC & Choose(Val(Mid(sIntD, j, 1)), "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖") & sBIT(Len(Trim(sIntD)) - j)
           Else
              If Val(Mid(sIntD, j + 1, 1)) <> 0 Then
                 NtoC = NtoC & "零"
              End If
           End If
       Next j
       lStartPos = lStartPos + iLength
       If i < iCount Then
          If (Val(Mid(sIntD, Len(Trim(sIntD)), 1)) <> 0 Or Val(Mid(sIntD, Len(Trim(sIntD)) - 1, 1)) <> 0 Or Val(Mid(sIntD, Len(Trim(sIntD)) - 2, 1)) Or Val(Mid(sIntD, Len(Trim(sIntD)) - 3, 1)) <> 0) Then
             NtoC = NtoC & sUNIT(i - 1)
          End If
       Else
          NtoC = NtoC & sUNIT(i - 1)
       End If
   Next
   If Len(Trim(NtoC)) > 0 Then
      NtoC = NtoC & Yuan
   End If
   '小数
   If InStr(1, Trim(sNum), ".") <> 0 Then
      sDecD = Right(sNum, Len(Trim(sNum)) - InStr(1, Trim(sNum), "."))
      For i = 1 To Len(Trim(sDecD))
          If Val(Mid(Trim(sDecD), i, 1)) <> 0 Then
             NtoC = NtoC & Choose(Val(Mid(Trim(sDecD), i, 1)), "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
             NtoC = NtoC & sCents(2 - i)
             If i >= 2 Then
                Exit For
             End If
          Else
             If Len(Trim(NtoC)) > 0 Then
                NtoC = NtoC & "零"
             End If
          End If
      Next i
   Else
      NtoC = NtoC & "整"
   End If
Else
   NtoC = "零" & Yuan
End If
End Function

Answer 5

贴多了!
Public Function NtoC ... 没用!

Answer 6

Option ExplicitPrivate Sub Command1_Click()
    Dim dd As Date
    dd = Now
    Text1.Text = NumberToChinese(Year(dd)) & "年" & NumberToChinese(Month(dd)) & "月" & NumberToChinese(Day(dd)) & "日"
End SubPrivate Function NumberToChinese(ByVal n As Long) As String
    Dim strNumber As String
    Dim strResult As String
    Dim i As Long
    strNumber = CStr(n)
    
    For i = 1 To Len(strNumber)
        strResult = strResult & GetNumberC(Val(Mid(strNumber, i, 1)))
    Next
    NumberToChinese = strResult
End FunctionPrivate Function GetNumberC(ByVal n As Long) As String
    Select Case n
        Case 0
            GetNumberC = "零"
        Case 1
            GetNumberC = "壹"
        Case 2
            GetNumberC = "贰"
        Case 3
            GetNumberC = "叁"
        Case 4
            GetNumberC = "肆"
        Case 5
            GetNumberC = "伍"
        Case 6
            GetNumberC = "陆"
        Case 7
            GetNumberC = "柒"
        Case 8
            GetNumberC = "捌"
        Case 9
            GetNumberC = "玖"
    End Select
        
End Function

Answer 7

to playyuer(女爱㊣)
是不是太麻烦了？

Answer 8

to seabluesky(海蓝天空):
to harryfox(龙):
   真是笑话!
   DeD(似水年华) 的　GetNumberC(31) 只能得出 "叁壹"
   如果仅仅是这样,我的函数更简单:
   Public Function GetChinese(sNum As String) As String
  Dim ii As Integer
  For ii = 1 To VBA.Len(sNum)
        GetChinese = GetChinese & Choose(Val(Mid(sNum, ii, 1)) + 1, "零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
  Next ii
End Function   而我的 GetChinese("3001",True) ="叁千零壹",GetChinese("31") ="叁壹"
我想我更对一些!

Answer 9

playyuer(女爱㊣)对不起啊，我不常上网，我找了半天，才会加分，结果还加错了，您的回答，非常正确，我的问题已经解决，再次表示感谢。

Answer 10

'不好意思加上正确处理
Option ExplicitPrivate Sub Command1_Click()
    Dim dd As Date
    dd = CDate(Text2.Text)
    Text1.Text = NumberToChinese(Year(dd)) & "年" & GetNumberM(Month(dd)) & "月" & NumberToChineseWithTen(Day(dd)) & "日"
End Sub
'NumberToChineseWithTen
Private Function NumberToChineseWithTen(ByVal n As Long) As String
    Dim strNumber As String
    Dim strResult As String
    Dim i As Long
    strNumber = CStr(n)
    If n <= 10 Then
        strResult = GetNumberM(n)
    ElseIf n < 20 And n > 10 Then
        strResult = GetDayExt(1) & GetNumberM(n - 10)
    ElseIf n >= 20 And n < 30 Then
        strResult = GetDayExt(2) & GetNumberM(n - 20)
    ElseIf n >= 30 Then
        strResult = GetDayExt(3) & GetNumberM(n - 30)
    End If
    NumberToChineseWithTen = strResult
End FunctionPrivate Function NumberToChinese(ByVal n As Long) As String
    Dim strNumber As String
    Dim strResult As String
    Dim i As Long
    strNumber = CStr(n)
    
    For i = 1 To Len(strNumber)
        strResult = strResult & GetNumberC(Val(Mid(strNumber, i, 1)))
    Next
    NumberToChinese = strResult
End FunctionPrivate Function GetNumberC(ByVal n As Long) As String
    Select Case n
        Case 0
            GetNumberC = "零"
        Case 1
            GetNumberC = "壹"
        Case 2
            GetNumberC = "贰"
        Case 3
            GetNumberC = "叁"
        Case 4
            GetNumberC = "肆"
        Case 5
            GetNumberC = "伍"
        Case 6
            GetNumberC = "陆"
        Case 7
            GetNumberC = "柒"
        Case 8
            GetNumberC = "捌"
        Case 9
            GetNumberC = "玖"
    End Select
        
End FunctionPrivate Function GetNumberM(ByVal n As Long) As String
    Select Case n
        Case 1
            GetNumberM = "一"
        Case 2
            GetNumberM = "二"
        Case 3
            GetNumberM = "三"
        Case 4
            GetNumberM = "四"
        Case 5
            GetNumberM = "五"
        Case 6
            GetNumberM = "六"
        Case 7
            GetNumberM = "七"
        Case 8
            GetNumberM = "八"
        Case 9
            GetNumberM = "九"
        Case 10
            GetNumberM = "十"
        Case 11
            GetNumberM = "十一"
        Case 12
            GetNumberM = "十二"
            
    End Select
        
End FunctionPrivate Function GetDayExt(ByVal n As Long) As String
    Select Case n
        Case 1
            GetDayExt = "十"
        Case 2
            GetDayExt = "二十"
        Case 3
            GetDayExt = "三十"
    End Select
End Function