Đánh giá chủ đề:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
[Hướng dẫn] dịch số sang chữ
#1
mình mới tập tành làm quen với access, vất vã lắm mới viết được phiếu chi nhưng không làm được đoạn mã dịch số tiền sang chữ.
mong các cao thủ hoàn chỉnh dùm mình với
thank
Chữ ký của thanhlap Xin chào, mình là thanhlap, Tham gia http://thuthuataccess.com/forum từ ngày 12-12 -13.
Reply
Những người đã cảm ơn
#2
Tạo 1 module chứa các đoạn code bên dưới
Mã:
Option Compare Database

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 = "Khoâng ñoàng"
Else
If Abs(BaoNhieu) > 1E+15 Then
KetQua = "Soá Quùa Lôùn"
Else
If BaoNhieu < 0 Then
KetQua = "Tröø" & Space(1)
Else
KetQua = Space(0)
End If
SOTIEN = Format(Abs(BaoNhieu), "###############")
SOTIEN = Right(Space(15) & SOTIEN, 15)
Hang = Array("None", "traêm", "möôi", "gì ñoù")
DOC = Array("None", "ngaøn tyû,", "tyû,", "trieäu,", "ngaøn,", "ñoàng .")
DEM = Array("None", "moät", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
For I = 1 To 5
NHOM = Mid(SOTIEN, I * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If I = 5 Then
Chu = "ñoàng chaün ." & Space(1)
Else
    Chu = Space(0)
End If
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 = "1" & Mid(Dich, 2)   'Kyù töï en lôø
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or _
(S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Or (S1 = "0" And I = 5) Then
Dich = "linh" & Space(1)
    End If
                 Case 1 And S = 0 And S3 <> "0"
                  If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or _
                  (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Or (S1 = "0" And I = 5) Then
                  Dich = "khoâng traêm" & Space(1)
    End If
    Case 1 And S = 0 And S3 = "0"
                  If (S1 >= "1" And S2 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or _
                  (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Or (S1 = "0" And I = 5) Then
                  Dich = "khoâng traêm" & Space(1)
                  End If
    End Select
Chu = Chu & Dich
Next J
End Select
Vitri = InStr(1, Chu, "möôi moät", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = "möôi moát"
KetQua = KetQua & Chu
End If
Next I
End If
End If
VND = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
Public Function USV(BaoNhieu)
'Dollar myõ'
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 = "Khoâng ñoàng"
Else
If Abs(BaoNhieu) > 999999999999.99 Then
KetQua = "Soá Quùa 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(12) & SOTIEN, 15)
Hang = Array("None", "traêm", "möôi", "gì ñoù")
DOC = Array("None", "tyû", "trieäu", "ngaøn", " dollar myõõ", "cent")
DEM = Array("None", "moät", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
For I = 1 To 5
NHOM = Mid(SOTIEN, I * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If I = 4 Then
Chu = "dollar myõ" & Space(1)
Else
    Chu = Space(0)
End If
    Case ".00"
If I = 5 Then
Chu = "chaün" & Space(0)
Else
    Chu = Space(0)
End If
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 = "1" & Mid(Dich, 2)   'Kyù töï en lôø
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
Dich = "linh" & Space(1)
End If
        
        W = Mid(SOTIEN, 14, 2)
        If W > "0" And I = 5 Then
        Dich = "leû" & Space(1)
        End If

        Case 1 And S = 0 And S3 <> "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Or (S1 = "0" And I = 5) Then
        Dich = "khoâng traêm" & Space(1)
        End If

Case 1 And S = 0 And S3 = "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
        Dich = "khoâng traêm" & Space(1)
        End If

End Select

        
Chu = Chu & Dich
Next J
End Select
Vitri = InStr(1, Chu, "möôi moät", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = "möôi moát"
KetQua = KetQua & Chu
End If
Next I
End If
End If
USV = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
Public Function AUV(BaoNhieu)
' Dollar Australia'
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 = "Khoâng ñoàng"
Else
If Abs(BaoNhieu) > 999999999999.99 Then
KetQua = "Soá Quùa 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(12) & SOTIEN, 15)
Hang = Array("None", "traêm", "möôi", "gì ñoù")
DOC = Array("None", "tyû", "trieäu", "ngaøn", "dollar australia", "cent")
DEM = Array("None", "moät", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
For I = 1 To 5
NHOM = Mid(SOTIEN, I * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If I = 4 Then
Chu = "dollar australia" & Space(1)
Else
    Chu = Space(0)
End If
    Case ".00"
If I = 5 Then
Chu = "chaün" & Space(0)
Else
    Chu = Space(0)
End If
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 = "1" & Mid(Dich, 2)   'Kyù töï en lôø
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
Dich = "linh" & Space(1)
End If
        
        W = Mid(SOTIEN, 14, 2)
        If W > "0" And I = 5 Then
        Dich = "leû" & Space(1)
        End If

        Case 1 And S = 0 And S3 <> "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Or (S1 = "0" And I = 5) Then
        Dich = "khoâng traêm" & Space(1)
        End If

Case 1 And S = 0 And S3 = "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
        Dich = "khoâng traêm" & Space(1)
        End If

End Select

        
Chu = Chu & Dich
Next J
End Select
Vitri = InStr(1, Chu, "möôi moät", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = "möôi moát"
KetQua = KetQua & Chu
End If
Next I
End If
End If
AUV = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
Public Function CAV(BaoNhieu)
'Dollar Canada'
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 = "Khoâng ñoàng"
Else
If Abs(BaoNhieu) > 999999999999.99 Then
KetQua = "Soá Quùa 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(12) & SOTIEN, 15)
Hang = Array("None", "traêm", "möôi", "gì ñoù")
DOC = Array("None", "tyû", "trieäu", "ngaøn", "dollar canada", "cent")
DEM = Array("None", "moät", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
For I = 1 To 5
NHOM = Mid(SOTIEN, I * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If I = 4 Then
Chu = "dollar canada" & Space(1)
Else
    Chu = Space(0)
End If
    Case ".00"
If I = 5 Then
Chu = "chaün" & Space(0)
Else
    Chu = Space(0)
End If
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 = "1" & Mid(Dich, 2)   'Kyù töï en lôø
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
Dich = "linh" & Space(1)
End If
        
        W = Mid(SOTIEN, 14, 2)
        If W > "0" And I = 5 Then
        Dich = "leû" & Space(1)
        End If

        Case 1 And S = 0 And S3 <> "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Or (S1 = "0" And I = 5) Then
        Dich = "khoâng traêm" & Space(1)
        End If

Case 1 And S = 0 And S3 = "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
        Dich = "khoâng traêm" & Space(1)
        End If

End Select

        
Chu = Chu & Dich
Next J
End Select
Vitri = InStr(1, Chu, "möôi moät", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = "möôi moát"
KetQua = KetQua & Chu
End If
Next I
End If
End If
CAV = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
Public Function HKV(BaoNhieu)
'Hoàng coâng'
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 = "Khoâng ñoàng"
Else
If Abs(BaoNhieu) > 999999999999.99 Then
KetQua = "Soá Quùa 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(12) & SOTIEN, 15)
Hang = Array("None", "traêm", "möôi", "gì ñoù")
DOC = Array("None", "tyû", "trieäu", "ngaøn", "dollar hoàng koâng", "cent")
DEM = Array("None", "moät", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
For I = 1 To 5
NHOM = Mid(SOTIEN, I * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If I = 4 Then
Chu = "dollar hoàng coâng" & Space(1)
Else
    Chu = Space(0)
End If
    Case ".00"
If I = 5 Then
Chu = "chaün" & Space(0)
Else
    Chu = Space(0)
End If
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 = "1" & Mid(Dich, 2)   'Kyù töï en lôø
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
Dich = "linh" & Space(1)
End If
        
        W = Mid(SOTIEN, 14, 2)
        If W > "0" And I = 5 Then
        Dich = "leû" & Space(1)
        End If

        Case 1 And S = 0 And S3 <> "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Or (S1 = "0" And I = 5) Then
        Dich = "khoâng traêm" & Space(1)
        End If

Case 1 And S = 0 And S3 = "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
        Dich = "khoâng traêm" & Space(1)
        End If

End Select

        
Chu = Chu & Dich
Next J
End Select
Vitri = InStr(1, Chu, "möôi moät", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = "möôi moát"
KetQua = KetQua & Chu
End If
Next I
End If
End If
HKV = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
Public Function SGV(BaoNhieu)
'Singapore
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 = "Khoâng ñoàng"
Else
If Abs(BaoNhieu) > 999999999999.99 Then
KetQua = "Soá Quùa 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(12) & SOTIEN, 15)
Hang = Array("None", "traêm", "möôi", "gì ñoù")
DOC = Array("None", "tyû", "trieäu", "ngaøn", "dollar singapore", "cent")
DEM = Array("None", "moät", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
For I = 1 To 5
NHOM = Mid(SOTIEN, I * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If I = 4 Then
Chu = "dollar singapore" & Space(1)
Else
    Chu = Space(0)
End If
    Case ".00"
If I = 5 Then
Chu = "chaün" & Space(0)
Else
    Chu = Space(0)
End If
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 = "1" & Mid(Dich, 2)   'Kyù töï en lôø
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
Dich = "linh" & Space(1)
End If
        
        W = Mid(SOTIEN, 14, 2)
        If W > "0" And I = 5 Then
        Dich = "leû" & Space(1)
        End If

        Case 1 And S = 0 And S3 <> "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Or (S1 = "0" And I = 5) Then
        Dich = "khoâng traêm" & Space(1)
        End If

Case 1 And S = 0 And S3 = "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
        Dich = "khoâng traêm" & Space(1)
        End If

End Select

        
Chu = Chu & Dich
Next J
End Select
Vitri = InStr(1, Chu, "möôi moät", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = "möôi moát"
KetQua = KetQua & Chu
End If
Next I
End If
End If
SGV = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
Public Function EUV(BaoNhieu)
'Euro chaâu aâu'
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 = "Khoâng ñoàng"
Else
If Abs(BaoNhieu) > 999999999999.99 Then
KetQua = "Soá Quùa 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(12) & SOTIEN, 15)
Hang = Array("None", "traêm", "möôi", "gì ñoù")
DOC = Array("None", "tyû", "trieäu", "ngaøn", "Euro", "cent")
DEM = Array("None", "moät", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
For I = 1 To 5
NHOM = Mid(SOTIEN, I * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If I = 4 Then
Chu = "Euro" & Space(1)
Else
    Chu = Space(0)
End If
    Case ".00"
If I = 5 Then
Chu = " chaün " & Space(0)
Else
    Chu = Space(0)
End If
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 = "1" & Mid(Dich, 2)   'Kyù töï en lôø
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
Dich = "linh" & Space(1)
End If
        
        W = Mid(SOTIEN, 14, 2)
        If W > "0" And I = 5 Then
        Dich = "leû" & Space(1)
        End If

        Case 1 And S = 0 And S3 <> "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Or (S1 = "0" And I = 5) Then
        Dich = "khoâng traêm" & Space(1)
        End If

Case 1 And S = 0 And S3 = "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
        Dich = "khoâng traêm" & Space(1)
        End If

End Select

        
Chu = Chu & Dich
Next J
End Select
Vitri = InStr(1, Chu, "möôi moät", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = "möôi moát"
KetQua = KetQua & Chu
End If
Next I
End If
End If
EUV = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
Public Function GBV(BaoNhieu)
' Baûng Anh
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 = "Khoâng ñoàng"
Else
If Abs(BaoNhieu) > 999999999999.99 Then
KetQua = "Soá Quùa 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(12) & SOTIEN, 15)
Hang = Array("None", "traêm", "möôi", "gì ñoù")
DOC = Array("None", "tyû", "trieäu", "ngaøn", "baûng anh", "cent")
DEM = Array("None", "moät", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
For I = 1 To 5
NHOM = Mid(SOTIEN, I * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If I = 4 Then
Chu = "baûng anh" & Space(1)
Else
    Chu = Space(0)
End If
    Case ".00"
If I = 5 Then
Chu = " chaün " & Space(0)
Else
    Chu = Space(0)
End If
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 = "1" & Mid(Dich, 2)   'Kyù töï en lôø
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
Dich = "linh" & Space(1)
End If
        
        W = Mid(SOTIEN, 14, 2)
        If W > "0" And I = 5 Then
        Dich = "leû" & Space(1)
        End If

        Case 1 And S = 0 And S3 <> "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Or (S1 = "0" And I = 5) Then
        Dich = "khoâng traêm" & Space(1)
        End If

Case 1 And S = 0 And S3 = "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
        Dich = "khoâng traêm" & Space(1)
        End If

End Select

        
Chu = Chu & Dich
Next J
End Select
Vitri = InStr(1, Chu, "möôi moät", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = "möôi moát"
KetQua = KetQua & Chu
End If
Next I
End If
End If
GBV = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
Public Function JPV(BaoNhieu)
' Yeân nhaät
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 = "Khoâng ñoàng"
Else
If Abs(BaoNhieu) > 999999999999.99 Then
KetQua = "Soá Quùa 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(12) & SOTIEN, 15)
Hang = Array("None", "traêm", "möôi", "gì ñoù")
DOC = Array("None", "tyû", "trieäu", "ngaøn", "yeân nhaät", "cent")
DEM = Array("None", "moät", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
For I = 1 To 5
NHOM = Mid(SOTIEN, I * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If I = 4 Then
Chu = "yeân nhaät" & Space(1)
Else
    Chu = Space(0)
End If
    Case ".00"
If I = 5 Then
Chu = " chaün " & Space(0)
Else
    Chu = Space(0)
End If
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 = "1" & Mid(Dich, 2)   'Kyù töï en lôø
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
Dich = "linh" & Space(1)
End If
        
        W = Mid(SOTIEN, 14, 2)
        If W > "0" And I = 5 Then
        Dich = "leû" & Space(1)
        End If

        Case 1 And S = 0 And S3 <> "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Or (S1 = "0" And I = 5) Then
        Dich = "khoâng traêm" & Space(1)
        End If

Case 1 And S = 0 And S3 = "0"
        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Then
        Dich = "khoâng traêm" & Space(1)
        End If

End Select

        
Chu = Chu & Dich
Next J
End Select
Vitri = InStr(1, Chu, "möôi moät", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = "möôi moát"
KetQua = KetQua & Chu
End If
Next I
End If
End If
JPV = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function

Public Function USMY(AMT)
'Tieáng anh'
Dim ToRead, Chuoi, NHOM, Word As String
Dim L, J As Byte, W, X, Y, Z As Double
Dim Donvi, HChuc, Khung
If AMT = 0 Then
          ToRead = "None"
Else
     Donvi = Array("None", "one", "tow", "three", "four", "five", "six", _
     "sevev", "eight", "nine", "ten", "eleven", "twelve", "thirteen", _
     "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen")
     HChuc = Array("None", "None", "twenty", "thirty", "forty", "fifty", "sixty", _
     "seventy", "eighty", "ninety")
     Khung = Array("None", "trillion", "billion", "million", "thounand", "dollars", "cents")
If AMT < 0 Then
    ToRead = "Minus" & Space(1)
    Else
    ToRead = Space(0)
    End If
Chuoi = Format(Abs(AMT), "###############.00") ' 18 Soá haøng ñôn vò vaø 2 soá leû thaäp phaân'
Chuoi = Right(Space(15) & Chuoi, 18)
For L = 1 To 6
   NHOM = Mid(Chuoi, L * 3 - 2, 3)
   If NHOM <> Space(3) Then
       Select Case NHOM
       Case "000"
              If L = 5 And Abs(AMT) > 1 Then
                  Word = "dollars" & 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 L = 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(L) & Space(1)
    End Select
    ToRead = ToRead & Word
  End If
  Next L
  End If
  USMY = UCase(Left(ToRead, 1)) & Mid(ToRead, 2)

End Function
Public Function SJV(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 = "Khoâng ñoàng"
Else
If Abs(BaoNhieu) > 1E+15 Then
KetQua = "Soá Quùa Lôùn"
Else
If BaoNhieu < 0 Then
KetQua = "Tröø" & Space(1)
Else
KetQua = Space(0)
End If
SOTIEN = Format(Abs(BaoNhieu), "###############")
SOTIEN = Right(Space(15) & SOTIEN, 15)
Hang = Array("None", "traêm", "möôi", "gì ñoù")
DOC = Array("None", "ngaøn tyû", "tyû", "trieäu", "löôïng", "ly .")
DEM = Array("None", "moät", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
For I = 1 To 5
NHOM = Mid(SOTIEN, I * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If I = 5 Then
Chu = "ly ." & Space(1)
Else
    Chu = Space(0)
End If
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 = "1" & Mid(Dich, 2)   'Kyù töï en lôø
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or _
(S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Or (S1 = "0" And I = 5) Then
Dich = "linh" & Space(1)
    End If
                 Case 1 And S = 0 And S3 <> "0"
                  If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or _
                  (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Or (S1 = "0" And I = 5) Then
                  Dich = "khoâng traêm" & Space(1)
    End If
    Case 1 And S = 0 And S3 = "0"
                  If (S1 >= "1" And S2 <= "9") Or (S1 = "0" And I = 1) Or (S1 = "0" And I = 2) Or _
                  (S1 = "0" And I = 3) Or (S1 = "0" And I = 4) Or (S1 = "0" And I = 5) Then
                  Dich = "khoâng traêm" & Space(1)
                  End If
    End Select
Chu = Chu & Dich
Next J
End Select
Vitri = InStr(1, Chu, "möôi moät", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = "möôi moát"
KetQua = KetQua & Chu
End If
Next I
End If
End If
SJV = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function

để sử dụng bạn gọi hàm =vnd([giá trị số])
Có gì đăng csdl lên mình hướng dẫn cho bạn
Chữ ký của quan_pc Lắp đặt Internet VNPT tại Điện Bàn - Quảng Nam - Hotline: 0915.636.745
ღღღღღTài sản của quan_pc (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#3
Hàm đọc số của bạn, được sử dụng rất OK, nhưng mà không hiển thị được tiếng việt.
Cám ơn
Chữ ký của tranthidepag Xin chào, mình là tranthidepag, Tham gia http://thuthuataccess.com/forum từ ngày 24-03 -14.
Reply
Những người đã cảm ơn
#4
Hàm trên sử dụng cho font VNI
Thân mến
Chữ ký của Xuân Thanh Trăm năm trước thì ta chưa gặp
Trăm năm sau biết gặp được không?
Cuộc đời sắc sắc không không
Thì thôi ta cứ hết lòng vì nhau
ღღღღღTài sản của Xuân Thanh (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#5
(25-03-14, 11:25 AM)tranthidepag Đã viết: Hàm đọc số của bạn, được sử dụng rất OK, nhưng mà không hiển thị được tiếng việt.
Cám ơn
Code đó sử dụng font vni, bạn tải file này về http://data.haiquan.name.vn/file/haiquan...TIMESB.rar giải nén ra sau đó copy vào control panel -> fonts bỏ vào đó rồi khởi động lại access là đc bạn nhé.
Chữ ký của quan_pc Lắp đặt Internet VNPT tại Điện Bàn - Quảng Nam - Hotline: 0915.636.745
ღღღღღTài sản của quan_pc (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#6
(25-03-14, 11:25 AM)tranthidepag Đã viết: Hàm đọc số của bạn, được sử dụng rất OK, nhưng mà không hiển thị được tiếng việt.
Cám ơn

Hàm đọc số của mình viết lâu rồi và dùng font Unicode.
Mã:
Function SoRaChu(ByVal SoTien As String) As String
Dim So
Dim Hang
So = Array("kh" & ChrW(244) & "ng", "m" & ChrW(7897) & "t", "hai", "ba", "b" & ChrW(7889) & "n", "n" & ChrW(259) & "m", "s" & ChrW(225) & "u", "b" & ChrW(7843) & "y", "t" & ChrW(225) & "m", "ch" & ChrW(237) & "n")
Hang = Array("", "ng" & ChrW(224) & "n", "tri" & ChrW(7879) & "u", "t" & ChrW(7881))
Dim I, j, donvi, chuc, tram As Integer
Dim str As String
str = ""
I = Len(SoTien)
If I = 0 Then
    str = So(0) & str
Else
    j = 0
    Do While I > 0
        donvi = Int(Mid(SoTien, I, 1))
        I = I - 1
        If I > 0 Then
            chuc = Int(Mid(SoTien, I, 1))
        Else
            chuc = -1
        End If
        I = I - 1
        If I > 0 Then
            tram = Int(Mid(SoTien, I, 1))
        Else
            tram = -1
        End If
        I = I - 1
        If donvi > 0 Or chuc > 0 Or tram > 0 Or j = 3 Then
            str = Hang(j) & " " & str
        End If
        j = j + 1
        If j > 3 Then
            j = 1
        End If
        If donvi = 1 And chuc > 1 Then
            str = "m" & ChrW(7889) & "t" & " " & str
        Else
            If donvi = 5 And chuc > 0 Then
                str = "l" & ChrW(259) & "m" & " " & str
            ElseIf donvi > 0 Then str = So(donvi) & " " & str
            End If
        End If
        If chuc < 0 Then
            Exit Do
        Else
           If chuc = 0 And donvi > 0 Then
                str = "l" & ChrW(7867) & " " & str
           ElseIf chuc = 1 Then str = "m" & ChrW(432) & ChrW(7901) & "i" & " " & str
           ElseIf chuc > 1 Then str = So(chuc) & " " & "m" & ChrW(432) & ChrW(417) & "i" & " " & str
           End If
        End If
        If tram < 0 Then
            Exit Do
        Else
           If tram > 0 Or chuc > 0 Or donvi > 0 Then
                str = So(tram) & " " & "tr" & ChrW(259) & "m" & " " & str
           End If
        End If
    Loop
End If
SoRaChu = UCase(Left(str, 1)) + Trim(Mid(str, 2)) & " " & ChrW(273) & ChrW(7891) & "ng ch" & ChrW(7861) & "n"
End Function
[/quote]
Chữ ký của vinh65 Có thể cùng vui khi thành công mà khó có thể cùng lo lúc ban đầu, đó là những kẻ tầm thường.
Tô Đông Pha
Reply
Những người đã cảm ơn Noname


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  Thay thế giá trị từ cột này sang cột khác trong 1 query trungminh 6 135 08-11-16, 03:24 PM
Bài mới nhất: ongke0711
  [Help] Update từ query A sang B phamvanvy2003 8 446 28-08-16, 10:11 PM
Bài mới nhất: tranthanhan1962
  cập nhật dử liệu từ 1 cột trong query sang 1 cột của table adamtitan37 3 310 02-11-15, 01:35 PM
Bài mới nhất: tranthanhan1962
  [Help] Lấy thông tin từ bảng này chuyển sang bảng khác hainm_invivo 2 533 07-11-13, 12:10 PM
Bài mới nhất: Xuân Thanh
  Giúp về query Update từ query sang Table với ạ! thanhtunghsb 9 1,222 24-09-13, 05:23 PM
Bài mới nhất: paulsteigel

Chuyển nhanh:


User(s) browsing this thread: 1 Guest(s)
Diễn Đàn Thơ Văn Thi Ẩm Lâu|Nhà Hàng Sông Thơ