Hãy đăng nhập để có nhiều chức năng hữu dụng hơn và xem ảnh rõ hơn!
Bạn phải đăng nhập để xem được nội dung, nếu bạn chưa có tài khoản? hãy Đăng ký mới
x
Mình dùng add in đọc số thành chữ nó dc kết quả như này
Mình muốn chuyển ngàn => nghìn
và đọc cả chữ số 0 nữa
cụ thể trong trường hợp này là : Một tỷ không trăm hai mươi ba triệu sáu trăm năm mươi nghìn không trăm bốn mươi chín nghìn đồng chẵn
Cám ơn !đây là code ạ:
Public Function USD(AMT)
Dim ToRead, Chuoi, Nhom, Word As String
Dim I, J As Byte, W, X, Y, Z As Double
Dim Donvi, HChuc, Khung
If AMT = 0 Then
ToRead = "Nought" & Space(1) & "USD"
Else
Donvi = Array("None", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen")
HChuc = Array("None", "None", "twenty", "thirty", "fourty", "fifty", "sixty", "seventy", "eighty", "ninety")
Khung = Array("None", "trillion", "billion", "million", "thousand", "USD", "cents")
If AMT < 0 Then
ToRead = "Minus" & Space(1)
Else
ToRead = Space(0)
End If
Chuoi = Format(Abs(AMT), "###############.00")
Chuoi = Right(Space(15) & Chuoi, 18)
For I = 1 To 6
Nhom = Mid(Chuoi, I * 3 - 2, 3)
If Nhom <> Space(3) Then
Select Case Nhom
Case "000"
If I = 5 And Abs(AMT) > 1 Then
Word = "USD" & Space(1)
Else
Word = Space(0)
End If
Case ".00"
Word = "only"
Case Else
X = Val(Left(Nhom, 1))
Y = Val(Mid(Nhom, 2, 1))
Z = Val(Right(Nhom, 1))
W = Val(Right(Nhom, 2))
If X = 0 Then
Word = Space(0)
Else
Word = Donvi(X) & Space(1) & "hundred" & Space(1)
If W > 0 And W < 21 Then
Word = Word & "and" & Space(1)
End If
End If
If I = 6 And Abs(AMT) > 1 Then
Word = "and" & Space(1) & Word
End If
If W < 20 And W > 0 Then
Word = Word & Donvi(W) & Space(1)
Else
If W >= 20 Then
Word = Word & HChuc(Y) & Space(1)
If Z > 0 Then
Word = Word & Donvi(Z) & Space(1)
End If
End If
End If
Word = Word & Khung(I) & Space(1)
End Select
ToRead = ToRead & Word
End If
Next I
End If
USD = UCase(Left(ToRead, 1)) & Mid(ToRead, 2)
End Function
Function VND(baonhieu)
'Tien Viet tieng Viet Font Unicode
Dim KetQua, SoTien, Nhom, Chu, Dich, S1, S2, S3 As String
Dim I, J, ViTri As Byte, S As Double
Dim Hang, Doc, Dem
If Trim(baonhieu) = "" Then
VND = ""
Exit Function
ElseIf baonhieu = 0 Then
VND = "kh" & ChrW(244) & "ng"
Exit Function
ElseIf IsDate(baonhieu) Then
ngay = Day(baonhieu)
Thang = Month(baonhieu)
Nam = Year(baonhieu)
VND = "ng" & ChrW(224) & "y " & ngay & " th" & ChrW(225) & "ng " & Thang & " n" & ChrW(462) & "m " & Nam
Exit Function
ElseIf IsNumeric(baonhieu) = True Then
'---------------------------------------------------------------------------------------------------------------------------------
'If baonhieu = 0 Then
'KetQua = "Kh" & ChrW$(244) & "ng " & ChrW$(273) & ChrW$(7891) & "ng"
'Else
'---------------------------------------------------------------------------------------------------------------------------------
If Abs(baonhieu) >= 1E+15 Then
KetQua = "S" & ChrW$(7889) & " qu" & ChrW$(225) & " l" & ChrW$(7899) & "n - H" & ChrW$(224) & "m " & ChrW$(273) & ChrW$(7893) & "i s" & ChrW$(7889) & " ra ch" & ChrW$(7919) & " Vi" & ChrW$(7879) & "t Nam; font ch" & ChrW$(7919) & " Tahoma - Copyright by VoTuanKiet of AMG (0938 73 73 93)"
Else
If baonhieu < 0 Then
KetQua = ChrW$(194) & "m" & Space(1)
Else
KetQua = Space(0)
End If
SoTien = Format(Abs(baonhieu), "##############0.00")
SoTien = Right(Space(15) & SoTien, 18)
Hang = Array("None", "tr" & ChrW$(259) & "m", "m" & ChrW$(432) & ChrW$(417) & "i", "g" & ChrW$(236) & " " & ChrW$(273) & "ã")
Doc = Array("None", "ng" & ChrW$(224) & "n t" & ChrW$(7927), "t" & ChrW$(7927), "tri" & ChrW$(7879) & "u", "ng" & ChrW$(224) & "n", ChrW$(273) & ChrW$(7891) & "ng", "")
Dem = Array("None", "m" & ChrW$(7897) & "t", "hai", "ba", "b" & ChrW$(7889) & "n", "n" & ChrW$(259) & "m", "s" & ChrW$(225) & "u", "b" & ChrW$(7849) & "y", "t" & ChrW$(225) & "m", "ch" & ChrW$(237) & "n")
For I = 1 To 6
Nhom = Mid(SoTien, I * 3 - 2, 3)
If Nhom <> Space(3) Then
Select Case Nhom
Case "000"
If I = 5 Then
Chu = ChrW$(273) & ChrW$(7891) & "ng" & Space(1)
Else
Chu = Space(0)
End If
Case ".00"
Chu = "ch" & ChrW$(7861) & "n"
Case Else
S1 = Left(Nhom, 1)
S2 = Mid(Nhom, 2, 1)
S3 = Right(Nhom, 1)
Chu = Space(0)
Hang(3) = Doc(I)
For J = 1 To 3
Dich = Space(0)
S = Val(Mid(Nhom, J, 1))
If S > 0 Then
Dich = Dem(S) & Space(1) & Hang(J) & Space(1)
End If
Select Case J
Case 2 And S = 1
Dich = "m" & ChrW$(432) & ChrW$(7901) & "i" & Space(1)
Case 3 And S = 0 And Nhom <> Space(2) & "0"
Dich = Hang(J) & Space(1)
Case 3 And S = 5 And S2 <> Space(1) And S2 <> "0"
Dich = "l" & Mid(Dich, 2)
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 4) Then
Dich = "l" & ChrW$(7867) & Space(1)
End If
End Select
Chu = Chu & Dich
Next J
End Select
ViTri = InStr(1, Chu, "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7897) & "t", 1)
If ViTri > 0 Then Mid(Chu, ViTri, 9) = "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7889) & "t"
KetQua = KetQua & Chu
End If
Next I
End If
End If
VND = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
Function LowerUni(Chuoi As String) As String
LowerUni = Application.WorksheetFunction.Trim(LCase(Chuoi))
End Function
Function ProperUni(Chuoi As String) As String
Chuoi = " " & Application.WorksheetFunction.Trim(LCase(Chuoi))
stt = Len(Chuoi)
If stt > 1 Then
Do
stt = InStrRev(Chuoi, " ", stt)
Mid(Chuoi, stt + 1, 1) = UCase(Mid(Chuoi, stt + 1, 1))
stt = stt - 1
Loop While stt > 0
ProperUni = Mid(Chuoi, 2)
End If
End Function
Function UpperUni(Chuoi As String) As String
UpperUni = Application.WorksheetFunction.Trim(UCase(Chuoi))
End Function
Sub ChuHoa()
For Each clls In Selection
If clls.HasFormula = False Then
clls.Value = UpperUni(clls.Text)
End If
Next clls
End Sub
Sub ChuThuong()
For Each clls In Selection
If clls.HasFormula = False Then
clls.Value = LowerUni(clls.Text)
End If
Next clls
End Sub
Sub ChuHoaThuong()
For Each clls In Selection
If clls.HasFormula = False Then
clls.Value = ProperUni(clls.Text)
End If
Next clls
End Sub
Sub ChuHoaDauDong()
For Each clls In Selection
If clls.HasFormula = False Then
clls.Value = UpperUni(Left(clls.Text, 1)) & LowerUni(Right(clls.Text, Len(clls.Text) - 1))
End If
Next clls
End Sub
|
Yêu thích
Theo dõi 
Chia sẻ
Bộ sưu tập
Thẻ cầu vòng