• Tùy chọn
• Đăng nhập
• Đăng ký
• Xem như trên Máy tính
• Accelerated Mobile Pages Theme

dịch số sang chữ

• Trang chủ

  • Thủ Thuật Access
  • Access Cơ Bản
  • Query
  • Hướng Dẫn dịch số sang chữ
• dịch số sang chữ

• dịch số sang chữ

  thanhlap > 20-12-13, 07:36 PM

  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

• RE: dịch số sang chữ

  quan_pc > 20-12-13, 10:50 PM

  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

• RE: dịch số sang chữ

  tranthidepag > 25-03-14, 11:25 AM

  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

• RE: dịch số sang chữ

  Xuân Thanh > 25-03-14, 09:23 PM

  Hàm trên sử dụng cho font VNI
  Thân mến

• RE: dịch số sang chữ

  quan_pc > 25-03-14, 09:41 PM

  (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é.

• RE: dịch số sang chữ

  vinh65 > 26-03-14, 10:07 AM

  (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]
• Bài trước Bài tiếp