Function Doisangsochuan(BaoNhieu)
BaoNhieu = Trim(BaoNhieu)
'Cat bỏ khoảng trống
Do While InStr(1,BaoNhieu," ") > 0
BaoNhieu = Mid(BaoNhieu, 1, InStr(1, BaoNhieu, " ") - 1) & Mid(BaoNhieu, InStr(1, BaoNhieu, " ") + 1)
Loop
Do While InStr(1, BaoNhieu, ".") > 0
BaoNhieu = Mid(BaoNhieu, 1, InStr(1, BaoNhieu, ".") - 1) & Mid(BaoNhieu, InStr(1, BaoNhieu, ".") + 1)
Loop
Doisangsochuan = BaoNhieu
End Function
'================================================= ====
'Hàm này dùng để đổi tiền từ số sang chuẩn
'================================================= ====
Function Tienchu(so)
Dim sotien, Hang, Donvi, Dem, tien
Dim Ketquacc
Dim n, Nhom, K
Hang = Array("None", "trăm", "mươi", "gì đó")
Donvi = Array("None", "ngàn tỷ", "tỷ", "triệu", "ngàn", "đồng", "")
Dem = Array("None", "một", "hai", "ba", "bốn", "năm", "sáu", "bảy", "tám", "chín")
sotien = CStr(Cdbl(Doisangsochuan(so))) 'Đưa số về dạng chuẩn ko có dấu phân cách
dai = len(sotien)
If Cdbl(sotien) = 0 then
Ketquacc = "Không đồng"
Else ' sotien khác 0
sotien = Abs(sotien) & ".00"
sotien = Right(Space(15) & sotien, 18) ' Lay tong cong 18 ky tu
For n = 1 to 6
Nhom = Mid(sotien, (n * 3) - 2, 3)
If Nhom <> Space(3) Then
Select Case Nhom
Case "000"
If n = 5 Then
chu = "đồng" & Space(1)
Else
chu = Space(0)
End If
Case ".00"
chu = ""
Case Else
S1 = Left(Nhom, 1) : S2 = Mid(Nhom, 2, 1) : S3 = Right(Nhom, 1)
chu = Space(0) : Hang(3) = Donvi(n)
For K = 1 To 3
dich = Space(0)
If (Mid(Nhom, K, 1) <> " ") then
S = Cint(Mid(Nhom, K, 1))
If S > 0 Then
dich = Dem(S) & Space(1) & Hang(K) & Space(1)
Else
If (K = 1) And (n > 1) And (n < 6) Then
dich = "không" & Space(1) & Hang(K) & Space(1)
End If
End If
Select Case K
Case 2 And S = 1
dich = "mười" & Space(1)
Case 3 And S = 0 And Nhom <> Space(2) & "0"
dich = Hang(K) & 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 n = 5) Then
dich = "lẻ" & Space(1)
End If
End Select ' Của K
chu = chu & dich
End if 'Của S khác " "
Next 'K
Vitri = InStr(chu, "mươi một")
If Vitri > 0 Then
chu = Thaythechuoi(chu,"mươi một","mươi mốt")
End If
Ketqua = Ketqua & chu
End Select
End if
Next ' Của n
End if
Ketquacc = UCase(Left(Ketqua, 1)) & Trim(Mid(Ketqua, 2))
if Instr(Ketquacc,"đồng") = 0 then
Ketquacc = Ketquacc & " đồng"
End if
Tienchu = Ketquacc
End Function
'Kết thúc hàm
Bookmarks