请问谁有写好的小写转大写程序?

Question

谁能提供一个,实在懒的写了,谢谢.

Answer 1

'
'将数字转化为大写金额.
'函数:CurToHz
'参数:Number 要转化的金额,Divvy 返回值分隔符(默认为"")
'返回值:String.[成功,则返回转化后的汉字金额,失败,返回 "ERR")
'例子:
Public Function CurToHz(ByVal Number As Double, Optional Divvy As String = "") As String
    Dim Number_string As String
    Dim Dot_pos As Integer
    Dim Result_string As String
    Dim Is_Zero As Boolean
    Dim This_Class_NoNumber As Boolean
    Dim Dig_string As String
    Dim Integer_Len As Integer, Decimal_Len As Integer
    Dim Class_val As Integer
    Dim Digit() As Variant
    Dim Digit_Format() As Variant
    Dim Class() As Variant
    Dim I As Long, N As Long
'/---------------------------------------------------------------------------
    Digit = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖", "元", "角", "分")
    Digit_Format = Array("", "拾", "佰", "仟")
    Class = Array("", "万", "亿", "兆")    Is_Zero = False
    Number_string = CStr(Number)
    Dot_pos = InStr(Number_string, ".")
    
    If Dot_pos = 0 Then
        '/ 该数为整数
        Integer_Len = Len(Number_string)
        If Integer_Len Mod 4 = 0 Then
            Class_val = Int(Integer_Len / 4) - 1
        Else
            Class_val = Int(Integer_Len / 4)
        End If
        For I = 1 To Integer_Len
            If (Integer_Len - I - Class_val * 4) = -1 Then
                If This_Class_NoNumber = False Then
                    Result_string = Result_string & Class(Class_val) & Divvy
                End If
                Class_val = Class_val - 1
                Is_Zero = False
                This_Class_NoNumber = True
            End If
            Dig_string = Mid$(Number_string, I, 1)
            If CInt(Dig_string) = 0 Then
                Is_Zero = True
            Else
                If Is_Zero = True Then
                    Result_string = Result_string & Digit(0) & Divvy
                End If
                Result_string = Result_string & Digit(Dig_string) & Divvy
                If (Integer_Len - I) Mod 4 <> 0 Then
                    Result_string = Result_string & Digit_Format(((Integer_Len - I) Mod 4)) & Divvy
                End If
                Is_Zero = False
                This_Class_NoNumber = False
            End If
        Next
        Result_string = Result_string & Divvy & Digit(10)
    Else
        '/ 该处为整数部分
        Integer_Len = Dot_pos - 1
        If Integer_Len Mod 4 = 0 Then
            Class_val = Int(Integer_Len / 4) - 1
        Else
            Class_val = Int(Integer_Len / 4)
        End If
        For I = 1 To Integer_Len
            If (Integer_Len - I - Class_val * 4) = -1 Then
                If This_Class_NoNumber = False Then
                    Result_string = Result_string & Class(Class_val) & Divvy
                End If
                Class_val = Class_val - 1
                Is_Zero = False
                This_Class_NoNumber = True
            End If
            Dig_string = Mid$(Number_string, I, 1)
            If CInt(Dig_string) = 0 Then
                Is_Zero = True
            Else
                If Is_Zero = True Then
                    Result_string = Result_string & Digit(0) & Divvy
                End If
                Result_string = Result_string & Digit(Dig_string) & Divvy
                If (Integer_Len - I) Mod 4 <> 0 Then
                    Result_string = Result_string & Digit_Format(((Integer_Len - I) Mod 4)) & Divvy
                End If
                Is_Zero = False
                This_Class_NoNumber = False
            End If
        Next
        If Integer_Len = 0 Then   '纯小数
            Result_string = Result_string & Digit(0) & Divvy
        End If
        Result_string = Result_string & Digit(10) & Divvy
        '/该处为小数部分
        For I = Dot_pos + 1 To Len(Number_string)
            N = N + 1 '小数点后两位.
            If N < 3 Then Result_string = Result_string & Digit(Mid$(Number_string, I, 1)) & Divvy & Digit(10 + N) & Divvy
        Next
    End If
    CurToHz = Result_string
End Function

Answer 2

'转换阿拉伯数字为中文人民币大写--------------------------------------------
'调用:Msgbox NtoC(123.45)
Public Function NtoC(ByVal sNum As String, _
    Optional BITs As String = ",拾,佰,仟", _
    Optional UNITs As String = ",[万],[亿],[兆],[万兆]", _
    Optional ByVal Yuan As String = "圆", _
    Optional ByVal Jiao As String = "角", _
    Optional ByVal Fen As String = "分") As String
    
    sNum = sNum
    If Val(sNum) < 0 Then
        NtoC = "零" & Yuan
        Exit Function
    End If
    
    
    Dim sIntD, sDecD As String
    Dim i, iCount, j, iLength As Integer
    Dim lStartPos As Long
    Dim sBIT() As String, sUNIT() As String, sCents(2) As String
        
    sBIT = VBA.Split(BITs, ",")
    sUNIT = VBA.Split(UNITs, ",")
    sCents(0) = Fen
    sCents(1) = Jiao
    Dim temp As String
    If InStr(sNum, ".") > 0 Then
        temp = Left(sNum, InStr(sNum, ".") - 1)
    Else
        temp = 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
                If i < UBound(sUNIT) + 1 Then
                    NtoC = NtoC & sUNIT(i - 1)
                    'Else
                    'NtoC = NtoC & sUNIT(i - 1)
                End If
            End If
        Else
        'If i < UBound(sUNIT) + 1 Then
            NtoC = NtoC & sUNIT(i - 1)
        'End If
        End If
    Next
    If Len(Trim(NtoC)) > 0 Then
        NtoC = NtoC & Yuan
    End If
    '小数
    If InStr(1, sNum, ".") <> 0 Then
        sDecD = Right(sNum, Len(sNum) - InStr(1, 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
            Else
                If Len(Trim(NtoC)) > 0 Then NtoC = NtoC & "零"
            End If
        Next i
    Else
        NtoC = NtoC & "整"
    End If
End Function

Answer 3

如下三个函数，调用changemoney()Function changnum(Num As Integer) As String     '自定义函数
Select Case Num
Case 0
changnum = "零"
Case 1
changnum = "壹"
Case 2
changnum = "贰"
Case 3
changnum = "叁"
Case 4
changnum = "肆"
Case 5
changnum = "伍"
Case 6
changnum = "陆"
Case 7
changnum = "柒"
Case 8
changnum = "捌"
Case 9
changnum = "玖"
End Select
End FunctionPublic Function changemoney(Num) As String      '自定义函数
Dim money1 As String
Dim tn As String
Dim k1 As String
Dim k2 As String
Dim k3 As String
If Num = 0 Then
changemoney = ""
Exit Function
End If
If Num < 0 Then
changemoney = "负" + changemoney(Abs(Num))
Exit Function
End If
money1 = Trim(str(Num))
tn = InStr(1, money1, ".")
k1 = ""
If tn <> 0 Then
st1 = Right(money1, Len(money1) - tn)
If st1 <> "" Then
t1 = Left(st1, 1)
st1 = Right(st1, Len(st1) - 1)
If t1 <> "0" Then
k1 = k1 + changnum(Val(t1)) + "角"
End If
If st1 <> "" Then
t1 = Left(st1, 1)
k1 = k1 + changnum(Val(t1)) + "分"
End If
st1 = Left(money1, tn - 1)
End If
Else
st1 = money1
End If
k2 = ""
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
k2 = changnum(Val(t1)) + k2
End If
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
If t1 <> "0" Then
k2 = changnum(Val(t1)) + "拾" + k2
Else
If Left(k2, 1) <> "零" Then
k2 = "零" + k2
End If
End If
End If
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
If t1 <> "0" Then
k2 = changnum(Val(t1)) + "佰" + k2
Else
If Left(k2, 1) <> "零" Then
k2 = "零" + k2
End If
End If
End If
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
If t1 <> "0" Then
k2 = changnum(Val(t1)) + "仟" + k2
Else
If Left(k2, 1) <> "零" Then
k = "零" + k2
End If
End If
End If
k3 = ""
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
k3 = changnum(Val(t1)) + k3
End If
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
If t1 <> "0" Then
k3 = changnum(Val(t1)) + "拾" + k3
Else
If Left(k3, 1) <> "零" Then
k3 = "零" + k3
End If
End If
End If
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
If t1 <> "0" Then
k3 = changnum(Val(t1)) + "佰" + k3
Else
If Left(k3, 1) <> "零" Then
k3 = "零" + k3
End If
End If
End If
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
If t1 <> "0" Then
k3 = changnum(Val(t1)) + "仟" + k3
End If
End If
If Right(k2, 1) = "零" Then
k2 = Left(k2, Len(k2) - 1)
End If
If Len(k3) > 0 Then
If Right(k3, 1) = "零" Then
k3 = Left(k3, Len(k3) - 1)
End If
k3 = k3 & "万"
End If
changemoney = IIf(k3 & k2 = "", k1, k3 & k2 & "元" & k1 & "整")
End FunctionFunction RMBbigWrite(strnum As String) As String        '自定义函数
If strnum = "0" Then
    RMBbigWrite = "零元"
Else
    RMBbigWrite = changemoney(Val(strnum))
End If
End Function

Answer 4

UCase()  小写转大写
LCase()  大写转小写