Nhờ sửa giùm code số --->chữ Unicode?

Liên hệ QC
B

Blacker

Thành viên mới
Tham gia
10/6/09
Bài viết
5
Được thích
0
Trước tôi có nhờ anh Tuanvn trên GPE làm đoạn code này,
Bây h tôi muốn chuyển sang font unicode thì làm thế nào?
Mong các bạn giúp đỡ,
Thanks
Mã: 
Function USDVN(baonhieu)
' Tien Viet tieng Viet Font TCVN - MaiKa of AQN (0953-357-988)"

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 = "không dollar"
Else
If Abs(baonhieu) >= 1E+15 Then
KetQua = "Sè qu¸ lín "

Else
If baonhieu < 0 Then
KetQua = "¢m" & Space(1)
Else
KetQua = Space(0)
End If
SoTien = Format(Abs(baonhieu), "##############0.00")
SoTien = Right(Space(15) & SoTien, 18)
Hang = Array("None", "tr¨m", "m­¬i", "g× ®ã")
Doc = Array("None", "ngµn tû", "tû", "triÖu", "ngµn", "Dollars Mü", "cents")
Dem = Array("None", "mét", "hai", "ba", "bèn", "n¨m", "s¸u", "bÈy", "t¸m", "chÝn")
For I = 1 To 6
Nhom = Mid(SoTien, I * 3 - 2, 3)
If Nhom <> Space(3) Then
Select Case Nhom
Case "000"
If I = 5 Then
Chu = "Dollars Mü" & Space(1)
Else
Chu = Space(0)
End If
Case ".00"
Chu = ""
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 = "l" & Mid(Dich, 2)
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 4) Then
Dich = "lÎ" & Space(1)
End If
End Select
Chu = Chu & Dich
Next J
End Select
ViTri = InStr(1, Chu, "m­¬i mét", 1)
If ViTri > 0 Then Mid(Chu, ViTri, 9) = "m­¬i mèt"
KetQua = KetQua & Chu
End If
Next I
End If
End If
USDVN = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
If InStr(1, UCase(Left(KetQua, 1)) & Mid(KetQua, 2), "cents", 1) > 0 Then
    USDVN = Replace(USDVN, "Dollars Mü", "Dollars Mü vµ")
End If

End Function
 
Tặng bạn nè. Hỗ trợ 3 loại bảng mã luôn: Unicode, VNI Windowns, TCVN3 (ABC)
PHP: 
Function DocSo(Number, Font) As String
Dim MyArray, tam
Dim Str As String, Str1 As String
Str = Format(Fix(Abs(Number)), "000000000000000000")
Select Case Font
Case 1
MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ", "dollar M" & ChrW(7929) & " ", "và ", "cents ")
Case 2
MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ", "dollar Myõ ", "vaø ", "cents ")
Case 3
MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m­¬i ", "kh«ng m­¬i kh«ng ", "kh«ng m­¬i", "lÎ", "m­¬i kh«ng", "m­¬i", "m­¬i n¨m", "m­¬i l¨m", "mét m­¬i", "m­êi", "m­¬i mét", "m­¬i mèt", "¢m ", "dollar Mü ", "vµ ", "cents ")
End Select
If Number = 0 Then
DocSo = MyArray(0)
Else
DocSo = ""
End If
For I = 1 To Len(Str)
If Left(Str, I) <> 0 And Mid(Str, (Int((I + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
    DocSo = DocSo & MyArray(Mid(Str, I, 1)) & MyArray(-(9 + I / 3) * (I Mod 3 = 0) - (15 + I Mod 3) * (I Mod 3 <> 0))
ElseIf I = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
    DocSo = DocSo & MyArray(12)
End If
Next
DocSo = IIf(Number = 0, MyArray(0) & MyArray(30), "") & IIf(Fix(Number) <> 0, DocSo & MyArray(30), "") & IIf(Fix(Number) <> 0 And Fix(Number) <> Number, MyArray(31), "") & IIf(Fix(Number) <> Number, IIf(Abs(Number - Fix(Number)) < 0.1, "", MyArray(Left(Right(Format(Abs(Number), "#.00"), 2), 1)) & MyArray(17)) & MyArray(Right(Format(Number, "#.00"), 1)) & MyArray(32), "")
DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)), ", " & MyArray(30), " " & MyArray(30)))
If Number < 0 Then
DocSo = MyArray(29) & DocSo
End If
DocSo = UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & "."
End Function
 

File đính kèm

  • DocSo.xls
    53.5 KB · Đọc: 86
Cảm ơn các bạn nhieu
 
huuthang_bd đã viết:
Tặng bạn nè. Hỗ trợ 3 loại bảng mã luôn: Unicode, VNI Windowns, TCVN3 (ABC)
PHP: 
Function DocSo(Number, Font) As String
Dim MyArray, tam
Dim Str As String, Str1 As String
Str = Format(Fix(Abs(Number)), "000000000000000000")
Select Case Font
Case 1
MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ", "dollar M" & ChrW(7929) & " ", "và ", "cents ")
Case 2
MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ", "dollar Myõ ", "vaø ", "cents ")
Case 3
MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m­¬i ", "kh«ng m­¬i kh«ng ", "kh«ng m­¬i", "lÎ", "m­¬i kh«ng", "m­¬i", "m­¬i n¨m", "m­¬i l¨m", "mét m­¬i", "m­êi", "m­¬i mét", "m­¬i mèt", "¢m ", "dollar Mü ", "vµ ", "cents ")
End Select
If Number = 0 Then
DocSo = MyArray(0)
Else
DocSo = ""
End If
For I = 1 To Len(Str)
If Left(Str, I) <> 0 And Mid(Str, (Int((I + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
    DocSo = DocSo & MyArray(Mid(Str, I, 1)) & MyArray(-(9 + I / 3) * (I Mod 3 = 0) - (15 + I Mod 3) * (I Mod 3 <> 0))
ElseIf I = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
    DocSo = DocSo & MyArray(12)
End If
Next
DocSo = IIf(Number = 0, MyArray(0) & MyArray(30), "") & IIf(Fix(Number) <> 0, DocSo & MyArray(30), "") & IIf(Fix(Number) <> 0 And Fix(Number) <> Number, MyArray(31), "") & IIf(Fix(Number) <> Number, IIf(Abs(Number - Fix(Number)) < 0.1, "", MyArray(Left(Right(Format(Abs(Number), "#.00"), 2), 1)) & MyArray(17)) & MyArray(Right(Format(Number, "#.00"), 1)) & MyArray(32), "")
DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)), ", " & MyArray(30), " " & MyArray(30)))
If Number < 0 Then
DocSo = MyArray(29) & DocSo
End If
DocSo = UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & "."
End Function
Nhấp chuột vào đây để mở rộng...

Bạn có thể chuyển chữ "dollar mỹ " sau cùng thành " đồng chẵn" được không, thanks.
 

File đính kèm

  • DocSo.xls
    53.5 KB · Đọc: 31
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

A
Áp dụng Chiêu số 18: Điều khiển Conditional Formating bằng checkbox.
Trả lời
2
Đọc
3
Quang_Hải
Quang_Hải
H
Kết nối vba với Database host (hiện tại đang làm host web)
2
Trả lời
23
Đọc
305
Haidang7979
H
N
  • Question
Mở từng file PDF ra in rồi đóng lại mở tiếp file khác trên cùng folder
Trả lời
5
Đọc
62
Hoàng Tuấn 868
H
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
Trả lời
1
Đọc
49
Emyeuexcel
Emyeuexcel
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2 3 4
Trả lời
66
Đọc
1K
ptm0412
ptm0412
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom