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

hàm đổi số thành chữ trong access

• Trang chủ

  • Thủ Thuật Access
  • Access Cơ Bản
  • Macro
  • hàm đổi số thành chữ trong access
• hàm đổi số thành chữ trong access

• hàm đổi số thành chữ trong access

  trico9.0 > 10-07-11, 10:26 PM

  xin mọi ngùời xem giúp mình hàm này sai chổ nào mà nó không chạy. bất kể là số mấy thì cũng ra "Không đồng chẳn"
  cám ơn!!!
  
  Public Function DoiSoRaChu(ByVal number As Long)
      Dim KetQua, SoTien, Nhom, Chu, Dich, N1, N2, N3 As String
      Dim I, J, N As Byte
      Dim Hang, Nghin, Dem
     
      Hang = Array("", "tam", "muoi", "")
      Dem = Array("", "mot", "hai", "ba", "bon", "nam", "sau", "bay", "tam", "chin")
      Nghin = Array("", "nghin ty", "ty", "trieu", "ngin", "dong")
     
      If nunber = 0 Then
          KetQua = "Khong dong "
      Else
          If Abs(number) >= 1E+15 Then
              KetQua = "So lon qua muc cho phep!"
          Else
              KetQua = ""
              If number < 0 Then
                  KetQua = "Am"
              End If
              SoTien = Format(Abs(number), "###############0.00")
              SoTien = Right(Space(15) & SoTien, 18)
             
              For I = 1 To 5
                  Nhom = Mid(SoTien, I * 3 - 2, 3)
                  If Nhom <> Space(3) And Nhom <> "000" Then
                      Chu = ""
                      N1 = Left(Nhom, 1)
                      N2 = Mid(Nhom, 2, 1)
                      N3 = Right(Nhom, 1)
                      Hang(3) = Nghin(I)
                          For J = 1 To 3
                              Dich = ""
                              N = Val(Mid(Nhom, J, 1))
                              If N > 0 Then
                                  Dich = Dem(N)
                                  If N3 = "1" And N2 > "1" And J = 3 Then Dich = "mot"
                                  If N = "5" And N2 > "0" And J = 3 Then Dich = "lam"
                                  Dich = Dich & Hang(J)
                              End If
                              Select Case J
                                  Case 1 And N1 = "0"
                                      Dich = "Khong tram "
                                  Case 2 And N = "1"
                                      Dich = "Muoi "
                                  Case 3 And N = "0" And Val(Nhom) <> 0
                                      Dich = Hang(J)
                                  Case 2 And N = "0" And Val(N3) > 0 And Len(Chu) > 0
                                      Dich = "linh "
                              End Select
                              Chu = Chu & Dich
                          Next J
                          KetQua = KetQua & Chu
                      End If
              Next I
          End If
      End If
      If KetQua = "So lon qua muc cho phep!" Then
          DoiSoRaChu = "So lon qua muc cho phep!"
      Else
          DoiSoRaChu = UCase(Left(KetQua, 1)) & Mid(KetQua, 2) & "chan."
      End If
  End Function

• RE: hàm đổi số thành chữ trong access

  Noname > 01-10-11, 10:30 AM

  Trong này đã có nhiều code đang dùng ổn định. Bạn tham khảo thử.
  
  Hàm đọc số thành chữ Unicode
  
  
  Hàm đọc số thành chữ bằng tiếng Anh

• RE: hàm đổi số thành chữ trong access

  gialilama > 12-02-12, 04:43 PM

  Các Bạn có thể xem đoạn code sau: Đang bị lỗi số 9 khi đọc trong unicode
  
  Mong các Bạn tham khảo và sửa giúp, nhớ cc cho mình: gialilamait@gmail.com
  Xin cảm ơn!
  
  
  
  Function Demtien(ByVal s As String) As String
  Dim So
  Dim hang
  So = Array("kh«ng", "mét", "hai", "ba", "bèn", "n¨m", "s¸u", "b¶y", "t¸m", "chY'n")
  
  hang = Array(" ", "ngh×n", "triÖu", "tû")
  Dim i, j, DonVi, chuc, Tram As Integer
  Dim str As String
  str = " "
  i = Len(s)
  If i = 0 Then
  str = So(0) & str
  Else
  j = 0
  Do While i > 0
  DonVi = Int(Mid(s, i, 1))
  i = i - 1
  If i > 0 Then
  chuc = Int(Mid(s, i, 1))
  Else
  chuc = -1
  End If
  
  i = i - 1
  If i > 0 Then
  Tram = Int(Mid(s, 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 = So(chuc) & " mèt" & " " & str
  Else
  If DonVi = 5 And chuc > 0 Then
  str = "l¨m" & " " & str
  ElseIf DonVi > 0 Then
  str = So(DonVi) & " " & str
  End If
  If chuc < 0 Then
  Exit Do
  Else
  If chuc = 0 And DonVi > 0 Then
  str = "lÎ" & " " & str
  ElseIf chuc = 1 Then str = "m­êi" & " " & str
  ElseIf chuc > 1 Then str = So(chuc) & " " & "m­¬i" & " " & str
  End If
  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¨m" & " " & str
  End If
  End If
  Loop
  '§æi kư tù ®Çu chuçi str thµnh ch÷ hoa( ®©y lµ ®o¹n thªm vµo)
  Dim g As String
  g = UCase(Left(Trim(str), 1))
  str = g + Mid(Trim(str), 2)
  Demtien = str
  'hƠt phÇn ®æi ch÷ thµnh ch÷ hoa
  End If
  Demtien = str
  End Function

• RE: hàm đổi số thành chữ trong access

  domfootwear > 13-02-12, 09:05 AM

  (12-02-12, 04:43 PM)gialilama Đã viết: Các Bạn có thể xem đoạn code sau: Đang bị lỗi số 9 khi đọc trong unicode
  
  Mong các Bạn tham khảo và sửa giúp, nhớ cc cho mình: gialilamait@gmail.com
  Xin cảm ơn!
  
  
  
  Function Demtien(ByVal s As String) As String
  Dim So
  Dim hang
  So = Array("kh«ng", "mét", "hai", "ba", "bèn", "n¨m", "s¸u", "b¶y", "t¸m", "chY'n")
  
  hang = Array(" ", "ngh×n", "triÖu", "tû")
  Dim i, j, DonVi, chuc, Tram As Integer
  Dim str As String
  str = " "
  i = Len(s)
  If i = 0 Then
  str = So(0) & str
  Else
  j = 0
  Do While i > 0
  DonVi = Int(Mid(s, i, 1))
  i = i - 1
  If i > 0 Then
  chuc = Int(Mid(s, i, 1))
  Else
  chuc = -1
  End If
  
  i = i - 1
  If i > 0 Then
  Tram = Int(Mid(s, 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 = So(chuc) & " mèt" & " " & str
  Else
  If DonVi = 5 And chuc > 0 Then
  str = "l¨m" & " " & str
  ElseIf DonVi > 0 Then
  str = So(DonVi) & " " & str
  End If
  If chuc < 0 Then
  Exit Do
  Else
  If chuc = 0 And DonVi > 0 Then
  str = "lÎ" & " " & str
  ElseIf chuc = 1 Then str = "m­êi" & " " & str
  ElseIf chuc > 1 Then str = So(chuc) & " " & "m­¬i" & " " & str
  End If
  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¨m" & " " & str
  End If
  End If
  Loop
  '§æi kư tù ®Çu chuçi str thµnh ch÷ hoa( ®©y lµ ®o¹n thªm vµo)
  Dim g As String
  g = UCase(Left(Trim(str), 1))
  str = g + Mid(Trim(str), 2)
  Demtien = str
  'hƠt phÇn ®æi ch÷ thµnh ch÷ hoa
  End If
  Demtien = str
  End Function

  Sai là phải rồi, người ta phải là "chÝn" chứ không phải "chY'n"
  
  

  Mã:

  Function Demtien(ByVal s As String) As String
Dim So
Dim hang
So = Array("kh«ng", "mét", "hai", "ba", "bèn", "n¨m", "s¸u", "b¶y", "t¸m", "chÝn")
hang = Array(" ", "ngh×n", "triÖu", "tû")
Dim i, j, DonVi, chuc, Tram As Integer
Dim str As String
str = " "
i = Len(s)
If i = 0 Then
str = So(0) & str
Else
j = 0
Do While i > 0
DonVi = Int(Mid(s, i, 1))
i = i - 1
If i > 0 Then
chuc = Int(Mid(s, i, 1))
Else
chuc = -1
End If

i = i - 1
If i > 0 Then
Tram = Int(Mid(s, 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 = So(chuc) & " mèt" & " " & str
Else
If DonVi = 5 And chuc > 0 Then
str = "l¨m" & " " & str
ElseIf DonVi > 0 Then
str = So(DonVi) & " " & str
End If
If chuc < 0 Then
Exit Do
Else
If chuc = 0 And DonVi > 0 Then
str = "lÎ" & " " & str
ElseIf chuc = 1 Then str = "m­êi" & " " & str
ElseIf chuc > 1 Then str = So(chuc) & " " & "m­¬i" & " " & str
End If
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¨m" & " " & str
End If
End If
Loop
'§æi ku+ tù ®Çu chuçi str thµnh ch÷ hoa( ®©y lµ ®o¹n thªm vµo)
Dim g As String
g = UCase(Left(Trim(str), 1))
str = g + Mid(Trim(str), 2)
Demtien = str
'hO+t phÇn ®æi ch÷ thµnh ch÷ hoa
End If
Demtien = str
End Function

• RE: hàm đổi số thành chữ trong access

  gialilama > 13-02-12, 12:20 PM

  Tại sao khi copy vào vẫn là""chY'n""? Bạn gõ kiểu gì mà được"chÝn" trong mã nguồn nhỉ?
  Vẫn đề về fons thật là phức tạp.
  Để mình xem lại chút.
  
  Xin cảm ơn bạn nhiều

• RE: hàm đổi số thành chữ trong access

  domfootwear > 13-02-12, 12:34 PM

  (13-02-12, 12:20 PM)gialilama Đã viết: Tại sao khi copy vào vẫn là""chY'n""? Bạn gõ kiểu gì mà được"chÝn" trong mã nguồn nhỉ?
  Vẫn đề về fons thật là phức tạp.
  Để mình xem lại chút.
  
  Xin cảm ơn bạn nhiều

  
  Cái này là kiểu gõ TCVN3(ABC) chứ không phải Unicode nhé.
  

• hàm đổi số thành chữ trong access

  buithuy986 > 01-03-12, 12:03 PM

  [/code]

• RE: hàm đổi số thành chữ trong access

  ChiMai > 30-09-16, 01:52 PM

  (13-02-12, 09:05 AM)domfootwear Đã viết:

  (12-02-12, 04:43 PM)gialilama Đã viết: Các Bạn có thể xem đoạn code sau: Đang bị lỗi số 9 khi đọc trong unicode
  
  Mong các Bạn tham khảo và sửa giúp, nhớ cc cho mình: gialilamait@gmail.com
  Xin cảm ơn!
  
                                 
  
  Function Demtien(ByVal s As String) As String
  Dim So
  Dim hang
     So = Array("kh«ng", "mét", "hai", "ba", "bèn", "n¨m", "s¸u", "b¶y", "t¸m", "chY'n")
  
     hang = Array(" ", "ngh×n", "triÖu", "tû")
  Dim i, j, DonVi, chuc, Tram As Integer
  Dim str As String
     str = " "
     i = Len(s)
  If i = 0 Then
     str = So(0) & str
  Else
     j = 0
     Do While i > 0
         DonVi = Int(Mid(s, i, 1))
         i = i - 1
         If i > 0 Then
             chuc = Int(Mid(s, i, 1))
         Else
             chuc = -1
         End If
         
         i = i - 1
         If i > 0 Then
             Tram = Int(Mid(s, 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 = So(chuc) & " mèt" & " " & str
         Else
             If DonVi = 5 And chuc > 0 Then
                 str = "l¨m" & " " & str
             ElseIf DonVi > 0 Then
                 str = So(DonVi) & " " & str
             End If
             If chuc < 0 Then
             Exit Do
             Else
                 If chuc = 0 And DonVi > 0 Then
                     str = "lÎ" & " " & str
                 ElseIf chuc = 1 Then str = "m­êi" & " " & str
                 ElseIf chuc > 1 Then str = So(chuc) & " " & "m­¬i" & " " & str
                 End If
             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¨m" & " " & str
             End If
         End If
     Loop
          '§æi kư tù ®Çu chuçi str thµnh ch÷ hoa( ®©y lµ ®o¹n thªm vµo)
     Dim g As String
         g = UCase(Left(Trim(str), 1))
         str = g + Mid(Trim(str), 2)
         Demtien = str
         'hƠt phÇn ®æi ch÷ thµnh ch÷ hoa
     End If
     Demtien = str
  End Function

  Sai là phải rồi, người ta phải là "chÝn" chứ không phải "chY'n"
  
  

  Mã:

  Function Demtien(ByVal s As String) As String
Dim So
Dim hang
So = Array("kh«ng", "mét", "hai", "ba", "bèn", "n¨m", "s¸u", "b¶y", "t¸m", "chÝn")
hang = Array(" ", "ngh×n", "triÖu", "tû")
Dim i, j, DonVi, chuc, Tram As Integer
Dim str As String
str = " "
i = Len(s)
If i = 0 Then
str = So(0) & str
Else
j = 0
Do While i > 0
DonVi = Int(Mid(s, i, 1))
i = i - 1
If i > 0 Then
chuc = Int(Mid(s, i, 1))
Else
chuc = -1
End If

i = i - 1
If i > 0 Then
Tram = Int(Mid(s, 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 = So(chuc) & " mèt" & " " & str
Else
If DonVi = 5 And chuc > 0 Then
str = "l¨m" & " " & str
ElseIf DonVi > 0 Then
str = So(DonVi) & " " & str
End If
If chuc < 0 Then
Exit Do
Else
If chuc = 0 And DonVi > 0 Then
str = "lÎ" & " " & str
ElseIf chuc = 1 Then str = "m­êi" & " " & str
ElseIf chuc > 1 Then str = So(chuc) & " " & "m­¬i" & " " & str
End If
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¨m" & " " & str
End If
End If
Loop
'§æi ku+ tù ®Çu chuçi str thµnh ch÷ hoa( ®©y lµ ®o¹n thªm vµo)
Dim g As String
g = UCase(Left(Trim(str), 1))
str = g + Mid(Trim(str), 2)
Demtien = str
'hO+t phÇn ®æi ch÷ thµnh ch÷ hoa
End If
Demtien = str
End Function

  
  Em cũng đang cần cái này anh ạ. Em tìm hoài mà chỉ thấy những hàm đọc sang chữ toàn hiện kiể chữ như bị mã hóa. Nó không hiện được chữ bình thường để đọc được?

• RE: hàm đổi số thành chữ trong access

  ongke0711 > 30-09-16, 03:09 PM

  Bạn dùng hàm này. Đã chuyển qua mã Unicode.
  
  

  Mã PHP:

  Function UniVND(SoTien As Double)
Dim A, B, X, Y As Double, Dso, Ddv, So, Dv, doc As String

If SoTien = 0 Then
UniVND = "kh" & ChrW(244) & "ng"
Exit Function
End If
A = Fix(Val(SoTien))
B = Len((A))
X = 1
Y = B - 1
Do
               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")
               Dso = So(Mid(A, X, 1))
               Dv = Array("", "m" & ChrW(432) & ChrW(417) & "i", "tr" & ChrW(259) & "m", "ng" & ChrW(224) & "n,", "m" & ChrW(432) & ChrW(417) & "i", "tr" & ChrW(259) & "m", "tri" & ChrW(7879) & "u,", "m" & ChrW(432) & ChrW(417) & "i", "tr" & ChrW(259) & "m", "t" & ChrW(7927) & ",", "m" & ChrW(432) & ChrW(417) & "i", "tr" & ChrW(259) & "m", "ng" & ChrW(224) & "n")
               Ddv = Dv(Y)
If Dso <> "kh" & ChrW(244) & "ng" Then
           If Ddv = "tr" & ChrW(259) & "m" Then
                           doc = doc & " " & Dso & " " & Ddv
           ElseIf Ddv = "m" & ChrW(432) & ChrW(417) & "i" Then
                       If Dso = "m" & ChrW(7897) & "t" Then
                               If X > 1 Then
                                   doc = doc & " " & "m" & ChrW(432) & ChrW(7901) & "i"
                               Else
                                   doc = "m" & ChrW(432) & ChrW(7901) & "i"
                               End If
                       Else
                               doc = doc & " " & Dso & " " & Ddv
                       End If
           Else
                                  If X > 1 Then
                                                If Dso = "m" & ChrW(7897) & "t" Then 'So 1
                                                       If Val(Mid(A, X - 1, 1)) > 1 Then
                                                              doc = doc & " " & "m" & ChrW(7889) & "t" & " " & Ddv
                                                       Else
                                                              doc = doc & " " & Dso & " " & Ddv
                                                       End If
                                                ElseIf Dso = "n" & ChrW(259) & "m" Then 'So 5
                                                       If Val(Mid(A, X - 1, 1)) > 0 Then
                                                              doc = doc & " " & "l" & ChrW(259) & "m" & " " & Ddv
                                                       Else
                                                              doc = doc & " " & Dso & " " & Ddv
                                                       End If
                                                Else
                                                       doc = doc & " " & Dso & " " & Ddv
                                                End If
                                         Else
                                                doc = doc & " " & Dso & " " & Ddv
                                         End If
               End If
   Else
           If Ddv = "tr" & ChrW(259) & "m" Then
                               If Val(Mid(A, X, 2)) = 0 And Val(Mid(A, X, 3)) = 0 Then
                                       doc = doc
                               Else
                                       doc = doc & " " & Dso & " " & Ddv
                               End If
            ElseIf Ddv = "m" & ChrW(432) & ChrW(417) & "i" Then
                               If Val(Mid(A, X, 2)) = 0 Then
                                   doc = doc
                               Else
                                   doc = doc & " l" & ChrW(7867)
                               End If
           Else
                               If X >= 3 Then
                                       If Val(Mid(A, X - 2, 3)) > 0 Or Y = 9 Or Y = 12 Then
                                               doc = doc & " " & Ddv
                                       Else
                                               doc = doc
                                       End If
                               Else
                                       If Val(Mid(A, X - 1, 2)) > 0 Or Y = 9 Or Y = 12 Then
                                               doc = doc & " " & Ddv
                                       Else
                                               doc = doc
                                       End If
                               End If
           End If
End If
X = X + 1
Y = Y - 1
Loop Until Y < 0
doc = Trim(doc)
   If Val(Right(A, 3)) = 0 Or Val(Right(A, 6)) = 0 Or Val(Right(A, 9)) = 0 Then
           doc = Left(doc, Len(doc) - 1)
   Else
           doc = doc
   End If
doc = UCase(Left(doc, 1)) & Right(doc, Len(doc) - 1)
UniVND = doc
End Function 

• Bài trước Bài tiếp