Public Function VND_Uni(howmuch, Optional v As Variant, Optional z As Variant)
If IsMissing(v) Then
VND_Uni = VND_Uni1(howmuch)
ElseIf TypeName(v) = "String" And IsMissing(z) Then
VND_Uni = VND_Uni2(howmuch, v)
ElseIf TypeName(v) = "String" And TypeName(z) = "String" Then
VND_Uni = VND_Uni3(howmuch, v, z)
Else
'Foo = v + 1
End If
End Function
'convert to unicode string
Public Function VND_Uni1(howmuch)
Dim ret, money, group, word, til, s1, s2, s3 As String
Dim i, j, index As Byte, s As Double
Dim row, spk, numbr
If howmuch = 0 Then
'zero
ret = "Không " & ChrW(273) & ChrW(7891) & "ng"
Else
If Abs(howmuch) > 1E+15 Then
'too large
ret = "S" & ChrW(7889) & " quá l" & ChrW(7899) & "n"
Else
'check nategative
If howmuch < 0 Then
ret = "Tr" & ChrW(7915) & Space(1)
Else
ret = Space(0)
End If
'format number
money = Format(Abs(howmuch), "##############0.00")
'18 chracter include number
money = Right(Space(15) & money, 18)
'row 100, 10, 0.1
row = Array("None", "tr" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i", "hào")
spk = Array("None", "ngàn t" & ChrW(7927), "t" & ChrW(7927), "tri" & ChrW(7879) & "u", "ngàn", ChrW(273) & ChrW(7891) & "ng", "xu")
numbr = Array("None", "m" & ChrW(7897) & "t", "hai", "ba", "b" & ChrW(7889) & "n", "n" & ChrW(259) & "m", "sáu", "b" & ChrW(7843) & "y", "tám", "chín")
'6 group (6x3)
For i = 1 To 6
'set group variable
group = Mid(money, i * 3 - 2, 3)
If group <> Space(3) Then
Select Case group
Case "000"
If i = 5 Then
'full 1000
word = ChrW(273) & ChrW(7891) & "ng" & Space(1)
Else
word = Space(0)
End If
Case ".00", ",00"
'decimal is 00
word = "ch" & ChrW(7861) & "n"
Case Else
'get number in group
s1 = Left(group, 1)
s2 = Mid(group, 2, 1)
s3 = Right(group, 1)
'set variable
word = Space(0)
row(3) = spk(i)
'for check group
For j = 1 To 3
til = Space(0)
'get number store to s
s = Val(Mid(group, j, 1))
If s > 0 Then
'read it
til = numbr(s) & Space(1) & row(j) & Space(1)
End If
Select Case j 'j is index
Case 2 And s = 1
'muoi xxx (10)
til = "m" & ChrW(432) & ChrW(7901) & "i" & Space(1)
Case 3 And s = 0 And group <> Space(2) & "0"
til = row(j) & Space(1)
Case 3 And s = 5 And s2 <> Space(1) And s2 <> "0"
til = "l" & Mid(til, 2) 'nam (5) --> lam
Case 2 And s = 0 And s3 <> "0"
If (s1 >= "1" And s1 <= "9") Or (s1 = "0" And i = 5) Then
til = "l" & ChrW(7867) & Space(1)
End If
End Select
word = word & til
Next j
End Select
index = InStr(1, word, "m" & ChrW(432) & ChrW(417) & "i m" & ChrW(7897) & "t", 1)
If index > 0 Then
Mid(word, index, 9) = "m" & ChrW(432) & ChrW(417) & "i m" & ChrW(7889) & "t"
End If
ret = ret & word
End If
Next i
End If
End If
'return
VND_Uni1 = Trim(UCase(Left(ret, 1)) & Mid(ret, 2)) & "."
End Function
'convert to unicode string
Public Function VND_Uni2(howmuch, mney)
Dim ret, money, group, word, til, s1, s2, s3 As String
Dim i, j, index As Byte, s As Double
Dim row, spk, numbr
If howmuch = 0 Then
'zero
ret = "Không " & mney
Else
If Abs(howmuch) > 1E+15 Then
'too large
ret = "S" & ChrW(7889) & " quá l" & ChrW(7899) & "n"
Else
'check nategative
If howmuch < 0 Then
ret = "Tr" & ChrW(7915) & Space(1)
Else
ret = Space(0)
End If
'format number
money = Format(Abs(howmuch), "##############0.00")
'18 chracter include number
money = Right(Space(15) & money, 18)
'row 100, 10, 0.1
row = Array("None", "tr" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i", "")
spk = Array("None", "ngàn t" & ChrW(7927), "t" & ChrW(7927), "tri" & ChrW(7879) & "u", "ngàn", mney, "cent") 'cent
numbr = Array("None", "m" & ChrW(7897) & "t", "hai", "ba", "b" & ChrW(7889) & "n", "n" & ChrW(259) & "m", "sáu", "b" & ChrW(7843) & "y", "tám", "chín")
'6 group (6x3)
For i = 1 To 6
'set group variable
group = Mid(money, i * 3 - 2, 3)
If group <> Space(3) Then
Select Case group
Case "000"
If i = 5 Then
'full 1000
word = mney & Space(1)
Else
word = Space(0)
End If
Case ".00", ",00"
'decimal is 00
word = "ch" & ChrW(7861) & "n"
Case Else
'get number in group
s1 = Left(group, 1)
s2 = Mid(group, 2, 1)
s3 = Right(group, 1)
'set variable
word = Space(0)
row(3) = spk(i)
'for check group
For j = 1 To 3
til = Space(0)
'get number store to s
s = Val(Mid(group, j, 1))
If s > 0 Then
'read it
til = numbr(s) & Space(1) & row(j) & Space(1)
End If
Select Case j 'j is index
Case 2 And s = 1
'muoi xxx (10)
til = "m" & ChrW(432) & ChrW(7901) & "i" & Space(1)
Case 3 And s = 0 And group <> Space(2) & "0"
til = row(j) & Space(1)
Case 3 And s = 5 And s2 <> Space(1) And s2 <> "0"
til = "l" & Mid(til, 2) 'nam (5) --> lam
Case 2 And s = 0 And s3 <> "0"
If (s1 >= "1" And s1 <= "9") Or (s1 = "0" And i = 5) Then
til = "l" & ChrW(7867) & Space(1)
End If
End Select
word = word & til
Next j
End Select
index = InStr(1, word, "m" & ChrW(432) & ChrW(417) & "i m" & ChrW(7897) & "t", 1)
If index > 0 Then
Mid(word, index, 9) = "m" & ChrW(432) & ChrW(417) & "i m" & ChrW(7889) & "t"
End If
ret = ret & word
End If
Next i
End If
End If
'return
VND_Uni2 = Trim(UCase(Left(ret, 1)) & Mid(ret, 2)) & "."
End Function
'convert to unicode string
Public Function VND_Uni3(howmuch, mney, perc)
Dim ret, money, group, word, til, s1, s2, s3 As String
Dim i, j, index As Byte, s As Double
Dim row, spk, numbr
If howmuch = 0 Then
'zero
ret = "Không " & mney
Else
If Abs(howmuch) > 1E+15 Then
'too large
ret = "S" & ChrW(7889) & " quá l" & ChrW(7899) & "n"
Else
'check nategative
If howmuch < 0 Then
ret = "Tr" & ChrW(7915) & Space(1)
Else
ret = Space(0)
End If
'format number
money = Format(Abs(howmuch), "##############0.00")
'18 chracter include number
money = Right(Space(15) & money, 18)
'row 100, 10, 0.1
row = Array("None", "tr" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i", "")
spk = Array("None", "ngàn t" & ChrW(7927), "t" & ChrW(7927), "tri" & ChrW(7879) & "u", "ngàn", mney, perc) 'cent option
numbr = Array("None", "m" & ChrW(7897) & "t", "hai", "ba", "b" & ChrW(7889) & "n", "n" & ChrW(259) & "m", "sáu", "b" & ChrW(7843) & "y", "tám", "chín")
'6 group (6x3)
For i = 1 To 6
'set group variable
group = Mid(money, i * 3 - 2, 3)
If group <> Space(3) Then
Select Case group
Case "000"
If i = 5 Then
'full 1000
word = mney & Space(1)
Else
word = Space(0)
End If
Case ".00", ",00"
'decimal is 00
word = "ch" & ChrW(7861) & "n"
Case Else
'get number in group
s1 = Left(group, 1)
s2 = Mid(group, 2, 1)
s3 = Right(group, 1)
'set variable
word = Space(0)
row(3) = spk(i)
'for check group
For j = 1 To 3
til = Space(0)
'get number store to s
s = Val(Mid(group, j, 1))
If s > 0 Then
'read it
til = numbr(s) & Space(1) & row(j) & Space(1)
End If
Select Case j 'j is index
Case 2 And s = 1
'muoi xxx (10)
til = "m" & ChrW(432) & ChrW(7901) & "i" & Space(1)
Case 3 And s = 0 And group <> Space(2) & "0"
til = row(j) & Space(1)
Case 3 And s = 5 And s2 <> Space(1) And s2 <> "0"
til = "l" & Mid(til, 2) 'nam (5) --> lam
Case 2 And s = 0 And s3 <> "0"
If (s1 >= "1" And s1 <= "9") Or (s1 = "0" And i = 5) Then
til = "l" & ChrW(7867) & Space(1)
End If
End Select
word = word & til
Next j
End Select
index = InStr(1, word, "m" & ChrW(432) & ChrW(417) & "i m" & ChrW(7897) & "t", 1)
If index > 0 Then
Mid(word, index, 9) = "m" & ChrW(432) & ChrW(417) & "i m" & ChrW(7889) & "t"
End If
ret = ret & word
End If
Next i
End If
End If
'return
VND_Uni3 = Trim(UCase(Left(ret, 1)) & Mid(ret, 2)) & "."
End Function
'crowe string to code
Function UniVba(TxtUni As String) As String
Dim n, uni1, uni2
If TxtUni = "" Then
'text is null
UniVba = """"""
Else
TxtUni = TxtUni & " " 'add space
'check first character
If AscW(Left(TxtUni, 1)) < 256 Then UniVba = """"
'for to convert
For n = 1 To Len(TxtUni) - 1
'get char to convert
uni1 = Mid(TxtUni, n, 1)
uni2 = AscW(Mid(TxtUni, n + 1, 1))
'convert
If AscW(uni1) > 255 And uni2 > 255 Then
UniVba = UniVba & "ChrW(" & AscW(uni1) & ") & "
ElseIf AscW(uni1) > 255 And uni2 < 256 Then
UniVba = UniVba & "ChrW(" & AscW(uni1) & ") & """
ElseIf AscW(uni1) < 256 And uni2 > 255 Then
UniVba = UniVba & uni1 & """ & "
Else
UniVba = UniVba & uni1
End If
Next
'last character
If Right(UniVba, 4) = " & """ Then
UniVba = Mid(UniVba, 1, Len(UniVba) - 4)
Else
UniVba = UniVba & """"
End If
End If
End Function
'convert vni string
Public Function VND_Vni(howmuch)
Dim ret, money, group, word, til, s1, s2, s3 As String
Dim i, j, index As Byte, s As Double
Dim row, spk, numbr
If howmuch = 0 Then
ret = "Khoâng ñoàng"
Else
If Abs(howmuch) > 1E+15 Then
ret = "Soá quaù lôùn"
Else
If howmuch < 0 Then
ret = "Tröø" & Space(1)
Else
ret = Space(0)
End If
money = Format(Abs(howmuch), "##############0.00")
money = Right(Space(15) & money, 18)
row = Array("None", "traêm", "möôi", "haøo")
spk = Array("None", "ngaøn tyû", "tyû", "trieäu", "ngaøn", "ñoàng", "xu.")
numbr = Array("None", "moät", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
For i = 1 To 6
group = Mid(money, i * 3 - 2, 3)
If group <> Space(3) Then
Select Case group
Case "000"
If i = 5 Then
word = "ñoàng" & Space(1)
Else
word = Space(0)
End If
Case ".00", ",00"
word = "chaün"
Case Else
s1 = Left(group, 1)
s2 = Mid(group, 2, 1)
s3 = Right(group, 1)
word = Space(0)
row(3) = spk(i)
For j = 1 To 3
til = Space(0)
s = Val(Mid(group, j, 1))
If s > 0 Then
til = numbr(s) & Space(1) & row(j) & Space(1)
End If
Select Case j
Case 2 And s = 1
til = "möôøi" & Space(1)
Case 3 And s = 0 And group <> Space(2) & "0"
til = row(j) & Space(1)
Case 3 And s = 5 And s2 <> Space(1) And s2 <> "0"
til = "l" & Mid(til, 2)
Case 2 And s = 0 And s3 <> "0"
If (s1 >= "1" And s1 <= "9") Or (s1 = "0" And i = 5) Then
til = "leû" & Space(1)
End If
End Select
word = word & til
Next j
End Select
index = InStr(1, word, "möôi moät", 1)
If index > 0 Then
Mid(word, index, 9) = "möôi moát"
End If
ret = ret & word
End If
Next i
End If
End If
'return
VND_Vni = UCase(Left(ret, 1)) & Mid(ret, 2)
End Function
Function bo_dau(ByVal sContent As String) As String
Dim i As Long
Dim intCode As Long
Dim sChar As String
Dim sConvert As String
bo_dau = AscW(sContent)
For i = 1 To Len(sContent)
sChar = Mid(sContent, i, 1)
If sChar <> "" Then
intCode = AscW(sChar)
End If
Select Case intCode
Case 273
sConvert = sConvert & "d"
Case 272
sConvert = sConvert & "D"
Case 224, 225, 226, 227, 259, 7841, 7843, 7845, 7847, 7849, 7851, 7853, 7855, 7857, 7859, 7861, 7863
sConvert = sConvert & "a"
Case 192, 193, 194, 195, 258, 7840, 7842, 7844, 7846, 7848, 7850, 7852, 7854, 7856, 7858, 7860, 7862
sConvert = sConvert & "A"
Case 232, 233, 234, 7865, 7867, 7869, 7871, 7873, 7875, 7877, 7879
sConvert = sConvert & "e"
Case 200, 201, 202, 7864, 7866, 7868, 7870, 7872, 7874, 7876, 7878
sConvert = sConvert & "E"
Case 236, 237, 297, 7881, 7883
sConvert = sConvert & "i"
Case 204, 205, 296, 7880, 7882
sConvert = sConvert & "I"
Case 242, 243, 244, 245, 417, 7885, 7887, 7889, 7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907
sConvert = sConvert & "o"
Case 210, 211, 212, 213, 416, 7884, 7886, 7888, 7890, 7892, 7894, 7896, 7898, 7900, 7902, 7904, 7906
sConvert = sConvert & "O"
Case 249, 250, 361, 432, 7909, 7911, 7913, 7915, 7917, 7919, 7921
sConvert = sConvert & "u"
Case 217, 218, 360, 431, 7908, 7910, 7912, 7914, 7916, 7918, 7920
sConvert = sConvert & "U"
Case 253, 7923, 7925, 7927, 7929
sConvert = sConvert & "y"
Case 221, 7922, 7924, 7926, 7928
sConvert = sConvert & "Y"
Case Else
sConvert = sConvert & sChar
End Select
Next
bo_dau = sConvert
End Function
Function GetData(ByVal FileName As String, Optional ByVal SheetName As String = "", Optional ByVal RangeAddress As String = "")
Dim cnn As Object, rsData As Object
Dim tmpArr, arr
Dim szConn As String, szSQL As String, tmp As String
Dim lR As Long, lC As Long, lVersn As Long
On Error GoTo ErrHandler
lVersn = Val(Application.Version)
Set cnn = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")
If lVersn < 12 Then
szConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";IMEX=1;"
Else
szConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
"Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
End If
If SheetName = "" Then
Dim Dbs As Object, db As Object
Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVersn < 12, "36", "120"))
Set db = Dbs.OpenDatabase(FileName, False, False, "Excel 8.0;")
tmp = db.TableDefs(0).Name
tmp = Replace(tmp, "''", "'")
SheetName = tmp
db.Close
Set Dbs = Nothing: Set db = Nothing
Else
SheetName = SheetName & "$"
End If
cnn.Open szConn
szSQL = "SELECT * FROM [" & SheetName & RangeAddress & "];"
rsData.Open szSQL, cnn, 1, 1
tmpArr = rsData.GetRows
ReDim arr(UBound(tmpArr, 2), UBound(tmpArr, 1))
rsData.Close: cnn.Close
For lR = LBound(tmpArr, 2) To UBound(tmpArr, 2)
For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
arr(lR, lC) = tmpArr(lC, lR)
Next
Next
GetData = arr
Set rsData = Nothing: Set cnn = Nothing
Exit Function
ErrHandler:
MsgBox Err.Description
Set rsData = Nothing: Set cnn = Nothing
End Function
Sub OpenFile() 'Du lieu cua Ky truoc
Dim arr, vFile
vFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsx;*.xlsm")
If TypeName(vFile) = "String" Then
arr = GetData(CStr(vFile))
If IsArray(arr) Then
ThisWorkbook.Sheets("DU_LIEU").Range("A1:M65000").ClearContents
ThisWorkbook.Sheets("DU_LIEU").Range("A1").Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr
MsgBox "TAO DU LIEU KY TRUOC THANH CONG!"
End If
End If
End Sub
Function ConvertToUnSign(ByVal sContent As String) As String
Dim i As Long
Dim intCode As Long
Dim sChar As String
Dim sConvert As String
ConvertToUnSign = AscW(sContent)
For i = 1 To Len(sContent)
sChar = Mid(sContent, i, 1)
If sChar <> "" Then
intCode = AscW(sChar)
End If
Select Case intCode
Case 273
sConvert = sConvert & "d"
Case 272
sConvert = sConvert & "D"
Case 224, 225, 226, 227, 259, 7841, 7843, 7845, 7847, 7849, 7851, 7853, 7855, 7857, 7859, 7861, 7863
sConvert = sConvert & "a"
Case 192, 193, 194, 195, 258, 7840, 7842, 7844, 7846, 7848, 7850, 7852, 7854, 7856, 7858, 7860, 7862
sConvert = sConvert & "A"
Case 232, 233, 234, 7865, 7867, 7869, 7871, 7873, 7875, 7877, 7879
sConvert = sConvert & "e"
Case 200, 201, 202, 7864, 7866, 7868, 7870, 7872, 7874, 7876, 7878
sConvert = sConvert & "E"
Case 236, 237, 297, 7881, 7883
sConvert = sConvert & "i"
Case 204, 205, 296, 7880, 7882
sConvert = sConvert & "I"
Case 242, 243, 244, 245, 417, 7885, 7887, 7889, 7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907
sConvert = sConvert & "o"
Case 210, 211, 212, 213, 416, 7884, 7886, 7888, 7890, 7892, 7894, 7896, 7898, 7900, 7902, 7904, 7906
sConvert = sConvert & "O"
Case 249, 250, 361, 432, 7909, 7911, 7913, 7915, 7917, 7919, 7921
sConvert = sConvert & "u"
Case 217, 218, 360, 431, 7908, 7910, 7912, 7914, 7916, 7918, 7920
sConvert = sConvert & "U"
Case 253, 7923, 7925, 7927, 7929
sConvert = sConvert & "y"
Case 221, 7922, 7924, 7926, 7928
sConvert = sConvert & "Y"
Case Else
sConvert = sConvert & sChar
End Select
Next
ConvertToUnSign = sConvert
End Function