Xin hàm Đọc số - Chuyển số thành chữ

  • Thread starter ngocsontea
  • Ngày gửi

5494 lượt xem

N

ngocsontea

Sơ cấp
16/3/08
2
0
0
Hà Nội
ngocsontea.net
Hi các members,

Mình có phần mềm kế toán được viết bằng access. Nhưng mình không biết hàm chuyển số thành chữ trong access để dùng cho Phiếu Thu chi, Nhập Xuất. Bạn nào có thì chuyển cho mình với nhé. Thanks.

nguyenson_tcs@yahoo.com.vn
 
V

vienlien87

Sơ cấp
15/10/09
53
2
8
60
Huế
Hàm VND(). Dùng font VNtimes new roman nhé.
Public Function vnd(baonhieu)
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 baonhieu = 0 Then
KetQua = "Khäng âäöng"
Else
If Abs(baonhieu) >= 1E+15 Then
KetQua = "Säú quaï låïn"
Else
If baonhieu < 0 Then
KetQua = "Træì" & Space(1)
Else
KetQua = Space(0)
End If
SoTien = Format(Abs(baonhieu), "##############0.00")
SoTien = Right(Space(15) & SoTien, 18)
Hang = Array("None", "tràm", "mæåi", "gç âoï")
doc = Array("None", "ngaìn tyí", "tyí", "triãûu", "ngaìn", "âäöng", ".")
Dem = Array("None", "mäüt", "hai", "ba", "bäún", "nàm", "saïu", "baíy", "taïm", "chê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 = "âäöng" & Space(0)
Else
Chu = Space(0)
End If
Case ".00"
Chu = "chàó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æåì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 (S >= "1" And S1 <= "9") Or (S1 = "0" And I = 4) Then
Dich = " leí" & Space(1)
End If
End Select
Chu = Chu & Dich
Next j
End Select
Vitri = InStr(1, Chu, "mæåi mäüt", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = " mæåi mäút"
KetQua = KetQua & Chu
End If
Next I
End If
End If
vnd = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
 

Thành viên trực tuyến

Không có thành viên trực tuyến.

Xem nhiều