Chỉnh sửa Hàm code đọc số thành chữ trong Excel (Font VNI) |
| Chỉnh sửa Hàm code đọc số thành chữ trong Excel (Font VNI) Posted: 09 Jan 2013 02:15 AM PST Mình có hàm code đọc số thành chữ trong Excel font chữ VNI hoàn chỉnh rồi nhưng muốn nhờ ACE chỉnh sửa lại code 1 chút là bỏ chữ "chẵn" và "xu" phía sau. VD1: =vnd(15000000) => Mười lăm triệu đồng chẵn (Sửa lại thành: Mười lăm triệu đồng) VD2: =vnd(15200600,91) => Mười lăm triệu hai trăm ngàn sáu trăm đồng chín mươi mốt xu (Sửa lại thành: Mười lăm triệu hai trăm ngàn sáu trăm đồng) Mã code: Code: Public Function VND(BaoNhieu)If Val(BaoNhieu) = 0 ThenKetQua = "Khoâng ñoàng"ElseIf Abs(BaoNhieu) > 1E+15 ThenKetQua = "Soá quaù lôùn"ElseIf BaoNhieu < 0 Then KetQua = "Tröø" & Space(1) Else KetQua = Space(0)SoTien = Format(Abs(BaoNhieu), "##############0.00") ' 18 coät soá, 2 soá leûSoTien = Right(Space(15) & SoTien, 18)Hang = Array("None", "traêm", "möôi", "gì ñoù")DonVi = Array("None", "ngaøn tyû", "tyû", "trieäu", "ngaøn", "ñoàng", "xu")Dem = Array("None", "moät", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")For VN = 1 To 6NhomSo = Mid(SoTien, VN * 3 - 2, 3)If NhomSo <> Space(3) ThenSelect Case NhomSoCase "000"If VN = 5 ThenChu = "ñoàng" & Space(1)ElseChu = Space(0)End IfCase ".00", ",00" ' "Chaám khoâng khoâng" hoaëc "Phaåy khoâng khoâng"Chu = "chaün"Case ElseS1 = Left(NhomSo, 1): S2 = Mid(NhomSo, 2, 1): S3 = Right(NhomSo, 1)Chu = Space(0): Hang(3) = DonVi(VN)For VK = 1 To 3Dich = Space(0): VS = Val(Mid(NhomSo, VK, 1))If VS > 0 ThenDich = Dem(VS) & Space(1) & Hang(VK) & Space(1)ElseIf VK = 1 And VN > 1 And VN < 6 And Val(Mid(SoTien, (VN - 1) * 3 - 2, 3)) > 0 ThenDich = "khoâng" & Space(1) & Hang(VK) & Space(1)End IfEnd IfSelect Case VKCase 2 And VS = 1Dich = "möôøi" & Space(1)Case 3 And VS = 0 And NhomSo <> Space(2) & "0"Dich = Hang(VK) & Space(1)Case 3 And VS = 5 And Val(S2) > 0Dich = "l" & Mid(Dich, 2) ' kyù töï en lôøCase 2 And VS = 0 And S3 <> "0"If VN > 1 And Val(Mid(SoTien, (VN - 1) * 3 - 2, 3)) > 0 _Or (Val(S1) > 0) ThenDich = "leû" & Space(1)End IfEnd SelectChu = Chu & DichNext VKEnd SelectViTri = InStr(1, Chu, "möôi moät")If ViTri > 0 Then Mid(Chu, ViTri, 9) = "möôi moát"KetQua = KetQua & ChuEnd IfNext VNEnd IfEnd IfVND = UCase(Left(KetQua, 1)) & Trim(Mid(KetQua, 2))End Function |
| Posted: 09 Jan 2013 12:51 AM PST ACE cho em hỏi cách tạo phiếu lĩnh lương pro giống trong file em đã đính kèm ( chỉ là 1 file hình, vì ko biết tại sao file đính kèm nặng quá ko lên được). Em thấy file này hay quá, nhưng ko biết cách làm thế nào để được như thông tin chữ màu đỏ trong hình có ghi. Mong mọi người mở lòng rộng lượng dạy bảo em ạ. :) Em cảm ơn rất nhiều.....-=.,, |
| You are subscribed to email updates from Diễn Đàn Giải Pháp Excel - Excel và Kế Toán To stop receiving these emails, you may unsubscribe now. | Email delivery powered by Google |
| Google Inc., 20 West Kinzie, Chicago IL USA 60610 | |
No comments:
Post a Comment