Mở file .xla đó lên xóa hết đi copy mớ này vào xem sao nha ...mình úp file ko được...nếu không tìm GPE có một đống luôn (Code của GPE)
Option Explicit
Function UnicodeChar(UniCharCode As String) As String
On Error GoTo loi
Dim Str
Dim desStr As String
Dim i
If Mid(UniCharCode, 1, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 2)
End If
If Right(UniCharCode, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 1, Len(UniCharCode) - 1)
End If
Str = UniCharCode
Str = Split(Str, ";")
For i = LBound(Str) To UBound(Str)
desStr = desStr & ChrW$("&H" & Str(i))
Next
UnicodeChar = desStr
loi:
Exit Function
End Function
Rem cu phap = sorachu()
Function SoRaChu(ByVal Numcurrency As Currency) As String
Static CharVND(9) As String, BangChu As String, i As Integer
Dim SoLe, SoDoi As Integer, PhanChan, Ten As String
Dim DonViTien As String, DonViLe As String
Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer
Dim Dong As Integer, Tram As Integer, Muoi As Integer, DonVi As Integer
DonViTien = ";111;1ED3;6E;67" ' ?o^`ng
DonViLe = ";78;75" ' xu
If Numcurrency = 0 Then
SoRaChu = UnicodeChar(";4B;68;F4;6E;67;20" & DonViTien)
Exit Function
End If
If Numcurrency > 922337203685477# Then ' So^' lo+'n nha^'t cu?a loa.i CURRENCY
SoRaChu = UnicodeChar(";4B;68;F4;6E;67;20;111;1ED5;69;20;111 ;1B0;1EE3;63;20;73" & _
";1ED1;20;6C;1EDB;6E;20;68;1A1;6E;20;39;32;32;2C;3 3;33;37" & _
";2C;32;30;33;2C;36;38;35;2C;34;37;37")
Exit Function
End If
CharVND(1) = ";6D;1ED9;74" ' mo^.t
CharVND(2) = ";68;61;69" ' hai
CharVND(3) = ";62;61" ' ba
CharVND(4) = ";62;1ED1;6E" ' bo^'n
CharVND(5) = ";6E;103;6D" ' na(m
CharVND(6) = ";73;E1;75" ' su
CharVND(7) = ";62;1EA3;79" ' ba?y
CharVND(8) = ";74;E1;6D" ' tm
CharVND(9) = ";63;68;ED;6E" ' chn
CharVND(0) = ";78;75"
SoLe = Int((Numcurrency - Int(Numcurrency)) * 100) ' 2 k so^'
PhanChan = Trim$(Str$(Int(Numcurrency)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan
NganTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Ngan = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))
If NganTy = 0 And Ty = 0 And Trieu = 0 And Ngan = 0 And Dong = 0 Then
BangChu = ";6B;68;F4;6E;67;20" + DonViTien + ";20"
i = 5
Else
BangChu = ""
i = 0
End If
Rem bat dau doi
While i <= 5
Select Case i
Case 0
SoDoi = NganTy
Ten = ";6E;67;68;EC;6E;20;74;1EF7" 'ngh×n ty?
Case 1
SoDoi = Ty
Ten = ";74;1EF7" ' ty?
Case 2
SoDoi = Trieu
Ten = ";74;72;69;1EC7;75" ' trie^.u
Case 3
SoDoi = Ngan
Ten = ";6E;67;68;EC;6E" 'ngh×n
Case 4
SoDoi = Dong
Ten = DonViTien ' ?o^`ng
Case 5
SoDoi = SoLe
Ten = DonViLe ' xu
End Select
If SoDoi <> 0 Then
Tram = Int(SoDoi / 100)
Muoi = Int((SoDoi - Tram * 100) / 10)
DonVi = (SoDoi - Tram * 100) - Muoi * 10
If Right(BangChu, 3) = ";20" Then
BangChu = Left(BangChu, Len(BangChu) - 3)
End If
BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";2C;20") + _
IIf(Tram <> 0, Trim(CharVND(Tram)) + ";20;74;72;103;6D;20", "")
If Muoi = 0 And Tram <> 0 And DonVi <> 0 Then
BangChu = BangChu + ";6C;1EBB;20"
Else
If Muoi <> 0 Then
BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, _
Trim(CharVND(Muoi)) + ";20;6D;1B0;1A1;69;20", ";6D;1B0;1EDD;69;20")
End If
End If
If Muoi <> 0 And DonVi = 5 Then
BangChu = BangChu + ";6C;103;6D;20" + Ten + ";20"
Else
If Muoi > 1 And DonVi = 1 Then
BangChu = BangChu + ";6D;1ED1;74;20" + Ten + ";20"
Else
BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + ";20" + Ten, Ten) + ";20"
End If
End If
Else
BangChu = BangChu + IIf(i = 4, DonViTien + "", "")
End If
i = i + 1
Wend
If Right(BangChu, 3) = ";20" Then
BangChu = Left(BangChu, Len(BangChu) - 3)
End If
BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";2e;20")
If SoLe = 0 Then
BangChu = BangChu + IIf(Right(BangChu, 3) = 0, "", ";20")
End If
BangChu = UnicodeChar(BangChu)
Rem doi sang tieng viet Unicode
Rem doi chu cai dau tien thanh chu hoa
Mid$(BangChu, 1, 1) = UCase$(Mid$(BangChu, 1, 1))
SoRaChu = BangChu
End Function
