Đánh giá chủ đề:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
hàm đổi số thành chữ trong access
#1
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
Chữ ký của trico9.0 Xin chào, mình là trico9.0, Tham gia http://thuthuataccess.com/forum từ ngày 17-05 -11.
Reply
Những người đã cảm ơn gialilama
#2
Trong này đã có nhiều code đang dùng ổn định. Bạn tham khảo thử.
Chữ ký của Noname 020
ღღღღღTài sản của Noname (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#3
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
Chữ ký của gialilama Xin chào, mình là gialilama, Tham gia http://thuthuataccess.com/forum từ ngày 08-02 -12.
Reply
Những người đã cảm ơn
#4
(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
Chữ ký của domfootwear Xin chào Guest, nếu Guest biết thủ thuật nào thì nên chia sẻ cho cộng đồng nhé.
ღღღღღTài sản của domfootwear (View All Items) ღღღღღ
Reply
Những người đã cảm ơn Noname , gialilama
#5
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
Chữ ký của gialilama Xin chào, mình là gialilama, Tham gia http://thuthuataccess.com/forum từ ngày 08-02 -12.
Reply
Những người đã cảm ơn
#6
(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é.
Chữ ký của domfootwear Xin chào Guest, nếu Guest biết thủ thuật nào thì nên chia sẻ cho cộng đồng nhé.
ღღღღღTài sản của domfootwear (View All Items) ღღღღღ
Reply
Những người đã cảm ơn gialilama
#7
Tongue 
Cry_smileCry_smile[/code]
Chữ ký của buithuy986 Xin chào, mình là buithuy986, Tham gia http://thuthuataccess.com/forum từ ngày 01-03 -12.
Reply
Những người đã cảm ơn
#8
(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?
Chữ ký của ChiMai ChiMai,gia nhập Thủ Thuật Access từ 14-07 -16.
Reply
Những người đã cảm ơn
#9
Bạn dùng hàm này. Đã chuyển qua mã Unicode.

Mã PHP:
Function UniVND(SoTien As Double)
Dim ABXAs DoubleDsoDdvSoDvdoc As String

If SoTien 0 Then
UniVND 
"kh" ChrW(244) & "ng"
Exit Function
End If
Fix(Val(SoTien))
Len((A))
1
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(AX1))
               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 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(A11)) > 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(AX2)) = And Val(Mid(AX3)) = 0 Then
                                       doc 
doc
                               Else
                                       doc 
doc " " Dso " " Ddv
                               End 
If
            ElseIf Ddv "m" ChrW(432) & ChrW(417) & "i" Then
                               If Val
(Mid(AX2)) = 0 Then
                                   doc 
doc
                               Else
                                   doc 
doc " l" ChrW(7867)
                               End If
           Else
                               If X 
>= 3 Then
                                       If Val
(Mid(A23)) > Or Or 12 Then
                                               doc 
doc " " Ddv
                                       Else
                                               doc 
doc
                                       End 
If
                               Else
                                       If Val
(Mid(A12)) > Or Or 12 Then
                                               doc 
doc " " Ddv
                                       Else
                                               doc 
doc
                                       End 
If
                               End If
           End If
End If
1
1
Loop Until Y 
0
doc 
Trim(doc)
   If Val(Right(A3)) = Or Val(Right(A6)) = Or Val(Right(A9)) = 0 Then
           doc 
Left(docLen(doc) - 1)
   Else
           doc 
doc
   End 
If
doc UCase(Left(doc1)) & Right(docLen(doc) - 1)
UniVND doc
End 
Function 
Chữ ký của ongke0711 If you BORN poor, it's not your mistake. But if you DIE poor, It's your mistake!
ღღღღღTài sản của ongke0711 (View All Items) ღღღღღ
Reply
Những người đã cảm ơn


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  Cần giúp đỡ về hàm if trong macro hvhvpdk 2 76 28-11-16, 01:04 PM
Bài mới nhất: hvhvpdk
  Hướng dẫn tạo Menu cho file Access bằng Macro Noname 44 31,792 10-11-16, 04:48 PM
Bài mới nhất: ongke0711
  [Hỏi] Macro Setvalue bị tắt sau khi chuyển thành file MDB toancvp 6 339 25-07-16, 07:28 PM
Bài mới nhất: toancvp
  Hỏi đáp về Access cơ bản của thành viên mới... paulsteigel 8 284 11-07-16, 03:07 PM
Bài mới nhất: cpucloi
  menu trong access 2007 anhhoa1208 1 962 22-06-15, 06:52 PM
Bài mới nhất: tranthanhan1962

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ơ