HeSanbi
Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨
- Tham gia
- 24/2/13
- Bài viết
- 2,595
- Được thích
- 4,001
- Giới tính
- Nam
Hôm nay tôi lại chia sẻ cho các bạn một đoạn code giúp các bạn có thể chuyển các bảng mã Tiếng Việt với nhau.
Thực ra là một ứng dụng được viết giữa chừng của tôi. Nhưng khi viết mã tôi cảm thấy cảm hứng không còn nữa, và dừng giữa chừng, nên đành chia sẻ để các bạn có hứng thú thì phát triển thành ứng dụng chuyển mã Tiếng Việt.
Chứ nếu tôi cứ để trong kho, thì thật phí chất xám mà tôi đã đổ vào nó.
Code không chỉ có công dụng để chuyển mã, mà có thể ứng dụng vào việc tìm kiếm Tiếng Việt nếu các bạn muốn.
Nếu trong VBE của bạn đã đặt phông phù hợp với bảng mã nào đó thì các bạn có thể dùng code chuyển mã này để viết tiếng Việt trong VBE
Và code chuyển mã này có thể thay thế tốt với cách chuyển mã từ UniKey Toolkit
Với code chuyển mã thì có đến 19 kiểu mã:
Hàm chuyển mã - convertVNICode:
Các bạn có thể nhập mã chuyển là số thứ tự hoặc Tên mã trong Danh sách mã
Hàm tự động phát hiện mã - detectVNICode:
Hàm danh sách mã - ListVNICode
Nếu các bạn cài thêm Add-in Tool VBA cũng do tôi phát triển sẽ trợ giúp tốt trong việc code:
giaiphapexcel.com
Nếu các bạn phát triển code mà có khó khăn gì cứ đăng câu hỏi ở bên dưới. Chúc các bạn thành công.
Hình ảnh mã tiếng Việt với phông thích hợp, nếu chuyển Add-in thành Book thì sẽ có:
Hình ảnh ứng dụng chuyển mã nếu hoàn thành:
Mã VBA:
Add-in bên dưới chưa hoàn thành, chỉ để tham khảo:
Thực ra là một ứng dụng được viết giữa chừng của tôi. Nhưng khi viết mã tôi cảm thấy cảm hứng không còn nữa, và dừng giữa chừng, nên đành chia sẻ để các bạn có hứng thú thì phát triển thành ứng dụng chuyển mã Tiếng Việt.
Chứ nếu tôi cứ để trong kho, thì thật phí chất xám mà tôi đã đổ vào nó.
Code không chỉ có công dụng để chuyển mã, mà có thể ứng dụng vào việc tìm kiếm Tiếng Việt nếu các bạn muốn.
Nếu trong VBE của bạn đã đặt phông phù hợp với bảng mã nào đó thì các bạn có thể dùng code chuyển mã này để viết tiếng Việt trong VBE
Và code chuyển mã này có thể thay thế tốt với cách chuyển mã từ UniKey Toolkit
Với code chuyển mã thì có đến 19 kiểu mã:
- Unicode Dựng sẵn
- Unicode Tổ hợp
- TCVN3
- VISCII
- VPS
- BK-HCM 1
- BK-HCM 2
- Vietware F
- Vietware X
- VNI Windows
- VNU
- VIQR
- UTF-8
- Win-CP 1258
- Hex Unicode
- Decimal NCRs
- Hex NCRs
- Không dấu 1 (Không thể chuyển ngược lại)
- Không dấu 2 (Không thể chuyển ngược lại)
Hàm chuyển mã - convertVNICode:
Mã:
Call convertVNICode("chuỗi hoặc Range (vùng)", "Từ mã", "sang mã")Hàm tự động phát hiện mã - detectVNICode:
Mã:
Call detectVNICode("chuỗi")Hàm danh sách mã - ListVNICode
Nếu các bạn cài thêm Add-in Tool VBA cũng do tôi phát triển sẽ trợ giúp tốt trong việc code:
VBA_FastCode v2.22 - Công cụ học và viết mã VBA một cách nhanh nhất (*27/10/2023)
***** CẬP NHẬT MỚI v2.2 ***** -------------------------------------------------------------------------- Add-in được chia sẻ dưới đây, đó là những gì tôi hiểu biết về VBA và đã viết ra nó. Một Add-in Tools chỉnh sửa code VBA rất đơn giản nhưng có thể giúp các bạn học VBA và viết code nhanh...
giaiphapexcel.com
Nếu các bạn phát triển code mà có khó khăn gì cứ đăng câu hỏi ở bên dưới. Chúc các bạn thành công.
Hình ảnh mã tiếng Việt với phông thích hợp, nếu chuyển Add-in thành Book thì sẽ có:
Hình ảnh ứng dụng chuyển mã nếu hoàn thành:
Mã VBA:
JavaScript:
' __ _____ _ ®
' \ \ / / _ | / \
' \ \ /| _ \/ / \
' \_/ |___/_/ \_\
'
Option Explicit
Private Sub convertVNICode_test()
Dim UTF8 As Variant, Char As Variant, A As Variant, b As Variant
Char = VBA.Array(ChrW(7898), ChrW(7899), ChrW(7900), ChrW(7901), ChrW(7902), ChrW(7903), ChrW(7904), ChrW(7905), ChrW(7906), ChrW(7907), _
ChrW(7912), ChrW(7913), ChrW(7914), ChrW(7915), ChrW(7916), ChrW(7917), ChrW(7918), ChrW(7919), ChrW(7920), ChrW(7921), _
ChrW(416), ChrW(218), ChrW(250), ChrW(217), ChrW(249), ChrW(7910), ChrW(7911), ChrW(360), ChrW(361), ChrW(7908), ChrW(7909), _
ChrW(7922), ChrW(7923), ChrW(7926), ChrW(7927), ChrW(7928), ChrW(7929), ChrW(7924), ChrW(7925))
UTF8 = VBA.Array("Õì", "õì", "ÕÌ", "õÌ", "ÕÒ", "õÒ", "ÕÞ", "õÞ", "Õò", "õò", _
"Ýì", "ýì", "ÝÌ", "ýÌ", "ÝÒ", "ýÒ", "ÝÞ", "ýÞ", "Ýò", "ýò", _
"õ", "Õ", "YÌ", "yÌ", "YÒ", "yÒ", "YÞ", "yÞ", "Yò", "yò", "ã ý Ý õ Õ Yì yì ð")
Dim Text As String
Text = VBA.Join(Char, " ")
Text = convertVNICode(Text, 2, 14)
Debug.Print Text
Text = VBA.Join(UTF8, " ")
Text = convertVNICode(Text, 14, 2)
'Debug.Print convertVNICode("R" & ChrW(7845) & "t vui " & ChrW(273) & "" & ChrW(432) & "" & ChrW(7907) & "c g" & ChrW(7863) & "p b" & ChrW(7841) & "n", _
2, 14)
End Sub
Private Sub convertVNICode_test2()
Dim s$, i%, r As Range, RG As Range, ws As Excel.Worksheet
Set ws = ActiveSheet
Set RG = ws.Range("A2").Resize(6000)
convertVNICode RG, constVniWin(), constUnicodeDS()
End Sub
Function convertVNICode(ByVal SourceInput, ByVal fromcode$, ByVal tocode$)
If fromcode = tocode Then
GoTo g
End If
On Error Resume Next
Dim O, A, b, i, j, c, d, g, f, dt As Object, ds As Object, e As Boolean
Select Case TypeName(SourceInput)
Case "Range": Set O = SourceInput
Case "String": O = SourceInput
Case Else: Exit Function
End Select
A = fromcode
b = tocode
getVNICode A, b
c = LBound(A): d = UBound(A)
g = LBound(b): f = UBound(b)
' dt là các kyì týò câÌn thay thêì trýõìc các kyì týò khác
' ds là các kyì týò ðýõòc thay thêì có trùng viò trí khác
Set dt = VBA.CreateObject("Scripting.Dictionary")
Set ds = VBA.CreateObject("Scripting.Dictionary")
' Các trýõÌng hõòp có thêÒ xaÒy ra:
' 1. Nêìu khác viò trí, có chung kyì týò.(CâÌn thay thêì sau cùng)
' VD: a, b, c, d, e
' b, h, j, l, k
' 2. Nêìu týÌ bên này có chýìa kyì týò bên kia, có hai trýõÌng hõòp:
' + Kyì týò trùng ðýìng viò trí trýõìc (CâÌn thay thêì sau)
' VD: a, b, c, j, e
' g, h, aj, l, m
' + Kyì týò trùng ðýìng viò trí sau (CâÌn thay thêì sau)
' VD: a, b, c, d, e
' g, h, ja, l, m
' 3. Nêìu hai kyì týò cùng viò trí, bãÌng nhau thiÌ không thay thêì.
For j = g To f
For i = c To d
If A(i) = b(j) Then
If i <> j Then
ds(A(i)) = VBA.Array(i, j)
End If
ElseIf b(j) Like "*" & A(i) & "*" Then
dt(A(i)) = VBA.Array(i, j)
End If
Next
Next
If IsObject(O) Then
SpeedOn e
For Each i In dt.items()
O.Replace What:=A(i(1)), Replacement:=b(i(1)), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next
For i = c To d
If A(i) <> b(i) Then
If Not (dt.exists(A(i)) Or ds.exists(A(i))) Then
O.Replace What:=A(i), Replacement:=b(i), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End If
End If
Next
For Each i In ds.items()
O.Replace What:=A(i(1)), Replacement:=b(i(1)), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next
SpeedOff e
Else
For Each i In dt.items()
O = VBA.Replace(O, A(i(1)), b(i(1)))
Next
For i = c To d
If A(i) <> b(i) Then
If Not (dt.exists(A(i)) Or ds.exists(A(i))) Then
O = VBA.Replace(O, A(i), b(i))
End If
End If
Next
For Each i In ds.items()
O = VBA.Replace(O, A(i(1)), b(i(1)))
Next
convertVNICode = O
End If
g:
Set dt = Nothing
Set ds = Nothing
On Error GoTo 0
End Function
Private Sub detectVNICode_test()
'Debug.Print detectVNICode(ChrW(7844) & " " & ChrW(7855))
Debug.Print detectVNICode([A2:A1000])
'Debug.Print convertVNICode([A2], detectVNICode([A2]), constUnicodeDS)
End Sub
Function detectVNICode(ByVal Source) As Integer
On Error Resume Next
Dim r, t$, i, j, k%, A, m&, X%, s&, l&, l1&, l2%, key$
Dim d As Object, D2 As Object
Static z As Object
Set d = priDictionary
Set D2 = priDictionary
If z Is Nothing Then
Set z = VNICodes2
End If
Select Case TypeName(Source)
Case "Range":
For Each r In Source
t = r.Value: GoSub detect
Next
Case "String":
If Source = vbNullString Then
Exit Function
End If
t = Source: GoSub detect
End Select
If d.Count Then
For Each j In d.Keys()
A = d(j)
If A > m Then
m = A: X = j
End If
Next
detectVNICode = X
End If
Exit Function
detect:
l1 = Len(t)
For Each j In z.Keys()
l2 = Len(j)
s = 1
r:
l = InStr(s, t, j)
If l Then
For k = 0 To l2 - 1
key = l + k
If d.exists(key) Then
s = l + l2: If s <= l1 Then GoTo r
Else
d.Add key, k
End If
Next
D2.Add j, z(j)
End If
N:
Next
d.RemoveAll
For Each j In D2.Keys()
For Each i In D2(j)
key = i
If d.exists(key) Then
k = d(key) + 1
d.Remove key
d.Add key, k
Else
d.Add key, 1
End If
Next
Next
Return
End Function
Private Function StandardizedForRE(ByVal Text$) As String
Dim A, i%, sp$(), l&, s$
For Each A In Array("\", ".", "?", "+", "*", "(", ")", "[", "]", "{", "}", "^", "$")
Text = Replace(Text, A, "\" & A)
Next
sp = Split(Text, "/")
For A = 0 To UBound(sp)
l = Len(Text)
For i = 1 To l
s = Mid(sp(i), i, 1)
Select Case AscW(s)
Case Is <= 128:
Case Else:
End Select
Next
Next
End Function
Sub VNICodes2_test()
Dim O, i
Set O = VNICodes2
For Each i In O.Keys()
Debug.Print i
Next
End Sub
Function VNICodes2() As Object
On Error Resume Next
Static d As Object
If Not d Is Nothing Then GoTo e
Dim z, i%, j%, v$, sp, A(), l1&, l2%
Set d = priDictionary
z = VNICodes
For i = 2 To 15
sp = Split(z(i), "/")
For l1 = 3 To 1 Step -1
For j = LBound(sp) To UBound(sp)
v = sp(j)
l2 = Len(v)
If l2 = l1 Then
If d.exists(v) Then
A = d(v): d.Remove v
ReDim Preserve A(UBound(A) + 1)
A(UBound(A)) = i
d.Add v, A
Else
d.Add v, Array(i)
End If
End If
N:
Next
Next
Next
e:
Set VNICodes2 = d
End Function
Private Function priDictionary()
Set priDictionary = VBA.CreateObject("Scripting.Dictionary")
End Function
Function VNICodes()
'https://en.wikipedia.org/wiki/Byte_order_mark
Const n_ = vbNullString
Dim A$, b$, c$, d$, e$, f, g, H, i%, j%, z(18)
A = ChrW(&H300): b = ChrW(&H301): c = ChrW(&H303): d = ChrW(&H309): e = ChrW(&H323)
f = VBA.Array(225, 224, 7843, 227, 7841, 259, 7855, 7857, 7859, 7861, 7863, 226, 7845, 7847, 7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 234, 7871, 7873, 7875, 7877, 7879, 237, 236, 7881, 297, 7883, 243, 242, 7887, 245, 7885, 244, 7889, 7891, 7893, 7895, 7897, 417, 7899, 7901, 7903, 7905, 7907, 250, 249, 7911, 361, 7909, 432, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, 7925, 273, 193, 192, 7842, 195, 7840, 258, 7854, 7856, 7858, 7860, 7862, 194, 7844, 7846, 7848, 7850, 7852, 201, 200, 7866, 7868, 7864, 202, 7870, 7872, 7874, 7876, 7878, 205, 204, 7880, 296, 7882, 211, 210, 7886, 213, 7884, 212, 7888, 7890, 7892, 7894, 7896, 416, 7898, 7900, 7902, 7904, 7906, 218, 217, 7910, 360, 7908, 431, 7912, 7914, 7916, 7918, 7920, 221, 7922, 7926, 7928, 7924, 272)
g = VBA.Array(97, 97, 97, 97, 97, 259, 259, 259, 259, 259, 259, 226, 226, 226, 226, 226, 226, 101, 101, 101, 101, 101, 234, 234, 234, 234, 234, 234, 105, 105, 105, 105, 105, 111, 111, 111, 111, 111, 244, 244, 244, 244, 244, 244, 417, 417, 417, 417, 417, 417, 117, 117, 117, 117, 117, 432, 432, 432, 432, 432, 432, 121, 121, 121, 121, 121, 273, 65, 65, 65, 65, 65, 258, 258, 258, 258, 258, 258, 194, 194, 194, 194, 194, 194, 69, 69, 69, 69, 69, 202, 202, 202, 202, 202, 202, 73, 73, 73, 73, 73, 79, 79, 79, 79, 79, 212, 212, 212, 212, 212, 212, 416, 416, 416, 416, 416, 416, 85, 85, 85, 85, 85, 431, 431, 431, 431, 431, 431, 89, 89, 89, 89, 89, 272)
H = VBA.Array(b, A, d, c, e, n_, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, b, A, d, c, e, n_, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, n_, b, A, d, c, e, n_, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, b, A, d, c, e, n_, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, n_)
UnicodeHex: z(16) = f
DecimalNCRs: z(17) = f
HexNCRs: z(18) = f
For i = LBound(f) To UBound(f)
A = Hex(f(i))
A = String(4 - Len(A), "0") & A
z(16)(i) = "\u" & A
z(17)(i) = "&#" & f(i) & ";"
z(18)(i) = "&#x" & A & ";"
f(i) = ChrW(f(i))
g(i) = ChrW(g(i)) & H(i)
Next
NotMask1____0: z(j) = "a/a/a/a/a/a/a/a/a/a/a/a/a/a/a/a/a/e/e/e/e/e/e/e/e/e/e/e/i/i/i/i/i/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/u/u/u/u/u/u/u/u/u/u/u/y/y/y/y/y/d/A/A/A/A/A/A/A/A/A/A/A/A/A/A/A/A/A/E/E/E/E/E/E/E/E/E/E/E/I/I/I/I/I/O/O/O/O/O/O/O/O/O/O/O/O/O/O/O/O/O/U/U/U/U/U/U/U/U/U/U/U/Y/Y/Y/Y/Y/D"
NotMask2____1: j = j + 1: z(j) = "a/a/a/a/a/" & ChrW(259) & "/" & ChrW(259) & "/" & ChrW(259) & "/" & ChrW(259) & "/" & ChrW(259) & "/" & ChrW(259) & "/â/â/â/â/â/â/e/e/e/e/e/ê/ê/ê/ê/ê/ê/i/i/i/i/i/o/o/o/o/o/ô/ô/ô/ô/ô/ô/" & ChrW(417) & "/" & ChrW(417) & "/" & ChrW(417) & "/" & ChrW(417) & "/" & ChrW(417) & "/" & ChrW(417) & "/u/u/u/u/u/" & ChrW(432) & "/" & ChrW(432) & "/" & ChrW(432) & "/" & ChrW(432) & "/" & ChrW(432) & "/" & ChrW(432) & "/y/y/y/y/y/" & ChrW(273) & "/A/A/A/A/A/" & ChrW(258) & "/" & ChrW(258) & "/" & ChrW(258) & "/" & ChrW(258) & "/" & ChrW(258) & "/" & ChrW(258) & "/Â/Â/Â/Â/Â/Â/E/E/E/E/E/Ê/Ê/Ê/Ê/Ê/Ê/I/I/I/I/I/O/O/O/O/O/Ô/Ô/Ô/Ô/Ô/Ô/" & ChrW(416) & "/" & ChrW(416) & "/" & ChrW(416) & "/" & ChrW(416) & "/" & ChrW(416) & "/" & ChrW(416) & "/U/U/U/U/U/" & ChrW(431) & "/" & ChrW(431) & "/" & ChrW(431) & "/" & ChrW(431) & "/" & ChrW(431) & "/" & ChrW(431) & "/Y/Y/Y/Y/Y/" & ChrW(272)
UnicodeDS___2: j = j + 1: z(j) = Join(f, "/")
UnicodeTH___3: j = j + 1: z(j) = Join(g, "/")
TCVN3_______4: j = j + 1: z(j) = "¸/µ/¶/·/¹/¨/¾/»/¼/½/Æ/©/Ê/Ç/È/É/Ë/Ð/Ì/Î/Ï/Ñ/ª/Õ/Ò/Ó/Ô/Ö/Ý/×/Ø/Ü/Þ/ã/ß/á/â/ä/«/è/å/æ/ç/é/¬/í/ê/ë/ì/î/ó/ï/ñ/ò/ô//ø/õ/ö/÷/ù/ý/ú/û/ü/þ/®/¸/µ/¶/·/¹/¡/¾/»/¼/½/Æ/¢/Ê/Ç/È/É/Ë/Ð/Ì/Î/Ï/Ñ/£/Õ/Ò/Ó/Ô/Ö/Ý/×/Ø/Ü/Þ/ã/ß/á/â/ä/¤/è/å/æ/ç/é/¥/í/ê/ë/ì/î/ó/ï/ñ/ò/ô/¦/ø/õ/ö/÷/ù/ý/ú/û/ü/þ/§"
VISCII______5: j = j + 1: z(j) = "á/à/ä/ã/Õ/å/¡/¢/Æ/Ç/£/â/¤/¥/¦/ç/§/é/è/ë/¨/©/ê/ª/«/¬//®/í/ì/ï/î/¸/ó/ò/ö/õ/÷/ô/¯/°/±/²/µ/½/¾/¶/·/Þ/þ/ú/ù/ü/û/ø/ß/Ñ/×/Ø/æ/ñ/ý/Ï/Ö/Û/Ü/ð/Á/À/Ä/Ã/€/Å//‚/Æ/Ç/ƒ/Â/„/…/†/ç/‡/É/È/Ë/ˆ/‰/Ê/Š/‹/Œ//Ž/Í/Ì/›/Î/˜/Ó/Ò/™/õ/š/Ô///‘/’/“/´/•/–/—/³/”/Ú/Ù/œ//ž/¿/º/»/¼/ÿ/¹/Ý/Ÿ/Ö/Û/Ü/Ð"
VPS_________6: j = j + 1: z(j) = "á/à/ä/ã/å/æ/¡/¢/£/¤/¥/â/Ã/À/Ä/Å/Æ/é/è/È/ë/Ë/ê/‰/Š/‹/Í/Œ/í/ì/Ì/ï/Î/ó/ò/Õ/õ/†/ô/Ó/Ò/°/‡/¶/Ö/§/©/ª/«/®/ú/ù/û/Û/ø/Ü/Ù/Ø/º/»/¿/š/ÿ/›/Ï/œ/Ç/Á/€//‚/å/ˆ//Ž//ð/¥/Â/ƒ/„/…/Å/Æ/É/×/Þ/þ/Ë/Ê//“/”/•/Œ/´/µ/·/¸/Î/¹/¼/½/¾/†/Ô/–/—/˜/™/¶/÷//ž/Ÿ/¦/®/Ú/¨/Ñ/¬/ø/Ð//¯/±/»/¿/Ý/²/ý/³/œ/ñ"
BKHCM1______7: j = j + 1: z(j) = "¾/¿/À/Á/Â/×/Ø/Ù/Ú/Û/Ü/Ý/Þ/ß/à/á/â/Ã/Ä/Å/Æ/Ç/ã/ä/å/æ/ç/è/È/É/Ê/Ë/Ì/Í/Î/Ï/Ð/Ñ/é/ê/ë/ì/í/î/ï/ð/ñ/ò/ó/ô/Ò/Ó/Ô/Õ/Ö/õ/ö/÷/ø/ù/ú/û/ü/ý/þ/ÿ/½/€//‚/ƒ/„/™/š/›/œ//˜/Ÿ/~/¡/¢/£/¤/…/†/‡/ˆ/‰/¥/¦/§/¨/©/ª/Š/‹/Œ//Ž///‘/’/“/«/¬//®/¯/°/±/²/³/´/µ/¶/”/•/–/—/˜/·/¸/¹/º/»/¼/{/^/`/|/Ž/}"
BKHCM2______8: j = j + 1: z(j) = "aá/aâ/aã/aä/aå/ù/ùæ/ùç/ùè/ùé/ùå/ê/êë/êì/êí/êî/êå/eá/eâ/eã/eä/eå/ï/ïë/ïì/ïí/ïî/ïå/ñ/ò/ó/ô/õ/oá/oâ/oã/oä/oå/ö/öë/öì/öí/öî/öå/ú/úá/úâ/úã/úä/úå/uá/uâ/uã/uä/uå/û/ûá/ûâ/ûã/ûä/ûå/yá/yâ/yã/yä/yå/à/AÁ/AÂ/AÃ/AÄ/AÅ/Ù/ÙÆ/ÙÇ/ÙÈ/ÙÉ/ÙÅ/Ê/ÊË/ÊÌ/ÊÍ/ÊÎ/ÊÅ/EÁ/EÂ/EÃ/EÄ/EÅ/Ï/ÏË/ÏÌ/ÏÍ/ÏÎ/Ïå/Ñ/Ò/Ó/Ô/Õ/OÁ/OÂ/OÃ/OÄ/OÅ/Ö/ÖË/ÖÌ/ÖÍ/ÖÎ/ÖÅ/Ú/ÚÁ/ÚÂ/ÚÃ/ÚÄ/ÚÅ/UÁ/UÂ/UÃ/UÄ/UÅ/Û/ÛÁ/ÛÂ/ÛÃ/ÛÄ/ÛÅ/YÁ/YÂ/YÃ/YÄ/YÅ/À"
VietwareF___9: j = j + 1: z(j) = "À/ª/¶/º/Á/Ÿ/Å/Â/Ã/Ä/Æ/¡/Ê/Ç/È/É/Ë/Ï/Ì/Í/Î/Ñ/£/Õ/Ò/Ó/Ô/Ö/Û/Ø/Ù/Ú/Ü/â/ß/à/á/ã/¤/ç/ä/å/æ/è/¥/ì/é/ê/ë/í/ò/î/ï/ñ/ó/§/÷/ô/õ/ö/ø/ü/ù/ú/û/ÿ/¢/À/ª/¶/º/Á/–/Å/Â/Ã/Ä/Æ/—/Ê/Ç/È/É/Ë/Ï/Ì/Í/Î/Ñ/™/Õ/Ò/Ó/Ô/Ö/Û/Ø/Ù/Ú/Ü/â/ß/à/á/ã/š/ç/ä/å/æ/è/›/ì/é/ê/ë/í/ò/î/ï/ñ/ó/œ/÷/ô/õ/ö/ø/ü/ù/ú/û/ÿ/˜"
VietwareX__10: j = j + 1: z(j) = "aï/aì/aí/aî/aû/à/àõ/àò/àó/àô/àû/á/áú/áö/áø/áù/áû/eï/eì/eí/eî/eû/ã/ãú/ãö/ãø/ãù/ãû/ê/ç/è/é/ë/oï/oì/oí/oî/oü/ä/äú/äö/äø/äù/äü/å/åï/åì/åí/åî/åü/uï/uì/uí/uî/uû/æ/æï/æì/æí/æî/æû/yï/yì/yí/yî/yñ/â/AÏ/AÌ/AÍ/AÎ/AÛ/À/ÀÕ/ÀÒ/ÀÓ/ÀÔ/ÀÛ/Á/ÁÚ/ÁÖ/ÁØ/ÁÙ/ÁÛ/EÏ/EÌ/EÍ/EÎ/EÛ/Ã/ÃÚ/ÃÖ/ÃØ/ÃÙ/ÃÛ/Ê/Ç/È/É/Ë/OÏ/OÌ/OÍ/OÎ/OÜ/Ä/ÄÚ/ÄÖ/ÄØ/ÄÙ/ÄÜ/Å/ÅÏ/ÅÌ/ÅÍ/ÅÎ/ÅÜ/UÏ/UÌ/UÍ/UÎ/UÛ/Æ/ÆÏ/ÆÌ/ÆÍ/ÆÎ/ÆÛ/YÏ/YÌ/YÍ/YÎ/YÑ/Â"
VniWin_____11: j = j + 1: z(j) = "aù/aø/aû/aõ/aï/aê/aé/aè/aú/aü/aë/aâ/aá/aà/aå/aã/aä/eù/eø/eû/eõ/eï/eâ/eá/eà/eå/eã/eä/í/ì/æ/ó/ò/où/oø/oû/oõ/oï/oâ/oá/oà/oå/oã/oä/ô/ôù/ôø/ôû/ôõ/ôï/uù/uø/uû/uõ/uï/ö/öù/öø/öû/öõ/öï/yù/yø/yû/yõ/î/ñ/AÙ/AØ/AÛ/AÕ/AÏ/AÊ/AÉ/AÈ/AÚ/AÜ/AË/AÂ/AÁ/AÀ/AÅ/AÃ/AÄ/EÙ/EØ/EÛ/EÕ/EÏ/EÂ/EÁ/EÀ/EÅ/EÃ/EÄ/Í/Ì/Æ/Ó/Ò/OÙ/OØ/OÛ/OÕ/OÏ/OÂ/OÁ/OÀ/OÅ/OÃ/OÄ/Ô/ÔÙ/ÔØ/ÔÛ/ÔÕ/ÔÏ/UÙ/UØ/UÛ/UÕ/UÏ/Ö/ÖÙ/ÖØ/ÖÛ/ÖÕ/ÖÏ/YÙ/YØ/YÛ/YÕ/Î/Ñ"
VNU________12: j = j + 1: z(j) = "Ÿ/¡/¨/¬//¯/°/±/²/³/´/µ/¶/·/¸/¹/º/¾/¿/À/Á/Â/Å/Æ/Ë/Ì/Í/Î/Ï/Ö/×/Ø/Ù/Ü/Ý/Þ/ß/à/á/â/ã/ä/å/æ/ç/è/é/ê/ë/ì/î/ï/ð/ñ/ò/õ/ö/÷/ø/ù/ú/û/ü/ý/þ/ÿ/½/€/" & ChrW(129) & "/‚/Ã/" & ChrW(7840) & "/ƒ/" & ChrW(7854) & "/" & ChrW(7856) & "/" & ChrW(7858) & "/" & ChrW(7860) & "/" & ChrW(7862) & "/„/…/" & ChrW(7846) & "/" & ChrW(7848) & "/" & ChrW(6) & "/" & ChrW(7852) & "/É/È/" & ChrW(7866) & "/" & ChrW(7868) & "/" & ChrW(7864) & "/‰/" & ChrW(7870) & "/" & ChrW(7872) & "/" & ChrW(7874) & "/" & _
ChrW(7876) & "/" & ChrW(7878) & "/Í/Ì/" & ChrW(7880) & "/" & ChrW(296) & "/" & ChrW(7882) & "/Œ/Ò/" & ChrW(7886) & "/Õ/" & ChrW(7884) & "/" & ChrW(141) & "/" & ChrW(7888) & "/" & ChrW(7890) & "/" & ChrW(7892) & "/" & ChrW(7894) & "/" & ChrW(7896) & "/" & ChrW(381) & "/" & ChrW(7898) & "/" & ChrW(7900) & "/" & ChrW(143) & "/" & ChrW(7904) & "/" & ChrW(7906) & "/˜/Ù/™/" & ChrW(360) & "/" & ChrW(7908) & "/œ/" & ChrW(157) & "/" & ChrW(7914) & "/" & ChrW(7916) & "/" & ChrW(7918) & "/" & ChrW(7920) & "/" & ChrW(382) & "/" & ChrW(7922) & "/" & ChrW(7926) & "/" & ChrW(7928) & "/" & ChrW(7924) & "/" & ChrW(272)
VIQR_______13: j = j + 1: z(j) = "a'/a`/a?/a~/a./a(/a('/a(`/a(?/a(~/a(./a^/a^'/a^`/a^?/a^~/a^./e'/e`/e?/e~/e./e^/e^'/e^`/e^?/e^~/e^./i'/i`/i?/i~/i./o'/o`/o?/o~/o./o^/o^'/o^`/o^?/o^~/o^./o+/o+'/o+`/o+?/o+~/o+./u'/u`/u?/u~/u./u+/u+'/u+`/u+?/u+~/u+./y'/y`/y?/y~/y./d-/A'/A`/A?/A~/A./A(/A('/A(`/A(?/A(~/A(./A^/A^'/A^`/A^?/A^~/A^./E'/E`/E?/E~/E./E^/E^'/E^`/E^?/E^~/E^./I'/I`/I?/I~/I./O'/O`/O?/O~/O./O^/O^'/O^`/O^?/O^~/O^./O+/O+'/O+`/O+?/O+~/O+./U'/U`/U?/U~/U./U+/U+'/U+`/U+?/U+~/U+./Y'/Y`/Y?/Y~/Y./DD"
UTF8_______14: j = j + 1: z(j) = "á/à /ả/ã/ạ/ă/ắ/ằ/ẳ/ẵ/ặ/â/ấ/ầ/ẩ/ẫ/áº/é/è/ẻ/ẽ/ẹ/ê/ế/á»/ể/á»…/ệ/Ã/ì/ỉ/Ä©/ị/ó/ò/á»/õ/á»/ô/ố/ồ/ổ/á»—/á»™/Æ¡/á»›/á»/ở/ỡ/ợ/ú/ù/ủ/Å©/ụ/Æ°/ứ/ừ/á»/ữ/á»±/ý/ỳ/á»·/ỹ/ỵ/Ä‘/Ã/À/Ả/Ã/Ạ/Ä‚/Ắ/Ằ/Ẳ/Ẵ/Ặ/Â/Ấ/Ầ/Ẩ/Ẫ/Ậ/É/È/Ẻ/Ẽ/Ẹ/Ê/Ế/Ề/Ể/Ễ/Ệ/Ã/ÃŒ/Ỉ/Ĩ/Ị/Ó/Ã’/Ỏ/Õ/Ọ/Ô/á»/á»’/á»”/á»–/Ộ/Æ /Ớ/Ờ/Ở/á» /Ợ/Ú/Ù/Ủ/Ũ/Ụ/Ư/Ứ/Ừ/Ử/á»®/á»°/Ã/Ỳ/Ỷ/Ỹ/á»´/Ä/"
WinCP1258__15: j = j + 1: z(j) = "á/à/aÒ/aÞ/aò/ã/ãì/ãÌ/ãÒ/ãÞ/ãò/â/âì/âÌ/âÒ/âÞ/âò/é/è/eÒ/eÞ/eò/ê/êì/êÌ/êÒ/êÞ/êò/í/iÌ/iÒ/iÞ/iò/ó/oÌ/oÒ/oÞ/oò/ô/ôì/ôÌ/ôÒ/ôÞ/ôò/õ/õì/õÌ/õÒ/õÞ/õò/ú/ù/uÒ/uÞ/uò/ý/ýì/ýÌ/ýÒ/ýÞ/ýò/yì/yÌ/yÒ/yÞ/yò/ð/Á/À/AÒ/AÞ/Aò/Ã/Ãì/ÃÌ/ÃÒ/ÃÞ/Ãò/Â/Âì/ÂÌ/ÂÒ/ÂÞ/Âò/É/È/EÒ/EÞ/Eò/Ê/Êì/ÊÌ/ÊÒ/ÊÞ/Êò/Í/IÌ/IÒ/IÞ/Iò/Ó/OÌ/OÒ/OÞ/Oò/Ô/Ôì/ÔÌ/ÔÒ/ÔÞ/Ôò/Õ/Õì/ÕÌ/ÕÒ/ÕÞ/Õò/Ú/Ù/UÒ/UÞ/Uò/Ý/Ýì/ÝÌ/ÝÒ/ÝÞ/Ýò/Yì/YÌ/YÒ/YÞ/Yò/Ð"
VNICodes = z
Erase z
End Function
Function getVNICode(fromcode, tocode)
Dim H, i, s, k%, z, l
z = VNICodes
l = ListVNICode
H = fromcode: GoSub g: fromcode = H
H = tocode: GoSub g: tocode = H
Exit Function
g:
For i = LBound(l) To UBound(l)
If H = l(i) Then
H = i
Exit For
End If
Next
H = Split(z(H), "/")
Return
End Function
Function ListVNICode()
ListVNICode = VBA.Array("Kh" & ChrW(244) & "ng d" & ChrW(7845) & "u 1", "Kh" & ChrW(244) & "ng d" & ChrW(7845) & "u 2", "Unicode D" & ChrW(7921) & "ng s" & ChrW(7861) & "n", "Unicode T" & ChrW(7893) & " h" & ChrW(7907) & "p", "TCVN3", "VISCII", "VPS", "BK-HCM 1", "BK-HCM 2", "Vietware F", "Vietware X", "VNI Windows", "VNU", "VIQR", "UTF-8", "Win-CP 1258", "Hex Unicode", "Decimal NCRs", "Hex NCRs")
End Function
Function constNotMask1(): constNotMask1 = 0: End Function
Function constNotMask2(): constNotMask2 = 1: End Function
Function constUnicodeDS(): constUnicodeDS = 2: End Function
Function constUnicodeTH(): constUnicodeTH = 3: End Function
Function constTCVN3(): constTCVN3 = 4: End Function
Function constVISCII(): constVISCII = 5: End Function
Function constVPS(): constVPS = 6: End Function
Function constBKHCM1(): constBKHCM1 = 7: End Function
Function constBKHCM2(): constBKHCM2 = 8: End Function
Function constVietwareF(): constVietwareF = 9: End Function
Function constVietwareX(): constVietwareX = 10: End Function
Function constVniWin(): constVniWin = 11: End Function
Function constVNU(): constVNU = 12: End Function
Function constVIQR(): constVIQR = 13: End Function
Function constUTF8(): constUTF8 = 14: End Function
Function constWinCP1258(): constWinCP1258 = 15: End Function
Function constHexUnicode(): constHexUnicode = 16: End Function
Function constDecimalNCRs(): constDecimalNCRs = 17: End Function
Function constHexNCRs(): constHexNCRs = 18: End Function
Function DialogExplorer(Optional FolderPath$, _
Optional sDesc$ = "All File", _
Optional sFilter$ = "*.*", _
Optional title$ = "File Open", _
Optional FileDialog& = 1, _
Optional InitialView& = 2, _
Optional ButtonName$ = "&Select", _
Optional MultiSelect As Boolean = 0) As Variant
DialogExplorer = ""
Dim Arr(), k, it
With Application.FileDialog(FileDialog) '1|4'
If ButtonName <> vbNullString Then .ButtonName = ButtonName
' If FolderPath <> vbNullString Then
' .InitialFileName = FolderPath
' Else
' .InitialFileName = Application.DefaultFilePath
' End If
If FileDialog = 1 Then
.Filters.Clear
.Filters.Add sDesc, sFilter
If sDesc$ <> "All File" Then .Filters.Add "All File", "*.*"
End If
If title <> vbNullString Then .title = title
.InitialView = InitialView 'msoFileDialogViewDetails'
.AllowMultiSelect = IIf(FileDialog = 4, False, MultiSelect)
If .Show Then
If FileDialog = 4 Then
DialogExplorer = .SelectedItems(1)
Else
For Each it In .SelectedItems
ReDim Preserve Arr(k): Arr(k) = it: k = k + 1
Next it
DialogExplorer = Arr
End If
End If
If FileDialog = 1 Then .Filters.Clear
End With
End Function
Sub SpeedOn(Optional turned As Boolean, _
Optional Screen As Boolean = True, _
Optional Events As Boolean = True, _
Optional Calcula As Boolean = True)
SetSpeedApp True, turned, Screen, Events, Calcula
End Sub
Sub SpeedOff(Optional turned As Boolean = True, _
Optional Screen As Boolean = True, _
Optional Events As Boolean = True, _
Optional Calcula As Boolean = True)
If Not turned Then
SetSpeedApp False, turned, Screen, Events, Calcula
End If
End Sub
Sub SetSpeedApp(Optional ByVal TurnOn As Boolean = False, _
Optional turned As Boolean, _
Optional Screen As Boolean = True, _
Optional Events As Boolean = True, _
Optional Calcula As Boolean = True)
On Error Resume Next
With Application
turned = (.ScreenUpdating = False And Screen) _
Or (.EnableEvents = False And Events) _
Or (.Calculation = xlCalculationManual And Calcula)
If TurnOn And Not turned Then
If .ScreenUpdating And Screen Then .ScreenUpdating = False
If .EnableEvents And Events Then .EnableEvents = False
If .Calculation <> xlCalculationManual And Calcula Then .Calculation = xlCalculationManual
'.CalculateBeforeSave = False
'.DisplayAlerts = False
'.Cursor = xlWait
'.StatusBar = True
'.EnableCancelKey = xlErrorHandler
ElseIf Not TurnOn And turned Then
If Not .ScreenUpdating And Screen Then .ScreenUpdating = True
If Not .EnableEvents And Events Then .EnableEvents = True
If .Calculation <> xlAutomatic And Calcula Then .Calculation = xlAutomatic
'.DisplayAlerts = True
'.CalculateBeforeSave = True
'.Cursor = xlDefault
'.StatusBar = False
'.EnableCancelKey = xlInterrupt
'.StatusBar = n_
End If
End With
'oAS.DisplayPageBreaks = False
End Sub
Function IsFileOpen(ByVal FileName As String)
Dim f As Integer
On Error Resume Next
f = FreeFile()
Open FileName For Input Lock Read As #f
Close f
On Error GoTo 0
Select Case VBA.Err
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: IsFileOpen = VBA.Err
End Select
On Error GoTo 0
End Function
Function getFileExtend(ByVal FileName As String)
Dim i%, s$, f$
For i = Len(FileName) To 1 Step -1
f = Mid(FileName, i, 1)
If f Like "[\/.]" Then
If f = "." Then
f = s
End If
Exit For
End If
s = f & s
f = vbNullString
Next
getFileExtend = f
End Function
Private Sub Clipboard_test()
Call Clipboard("Xin ch" & ChrW(224) & "o t" & ChrW(7845) & "t c" & ChrW(7843) & " c" & ChrW(225) & "c b" & ChrW(7841) & "n")
Debug.Print Clipboard()
End Sub
Function Clipboard(Optional StoreText As String) As String
Dim X As Variant
X = StoreText
With VBA.CreateObject("htmlfile")
With .parentWindow.clipboardData
Select Case True
Case Len(StoreText)
.setData "Text", X
Case Else
Clipboard = .GetData("Text")
End Select
End With
End With
End Function
Private Sub convertFileVNICode_test()
Call convertFileVNICode(ThisWorkbook.FullName, 2, 5)
End Sub
Function convertFileVNICode(ByVal FileName$, ByVal fromcode$, ByVal tocode$)
If IsFileOpen(FileName) Then
GoTo e
End If
Dim Ext$, FSO As Object, f, SF$
Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
Set f = FSO.GetFile(FileName)
SF = f.Name
Ext = LCase(getFileExtend(FileName))
Select Case Ext
Case "xlam", "xla", "xls", "xlsx", "xlsm", "xlsb"
Case "rst", "csv", "txt", "xml", "htm", "html", "json", "js"
End Select
e:
Set FSO = Nothing
End FunctionAdd-in bên dưới chưa hoàn thành, chỉ để tham khảo:
Lần chỉnh sửa cuối:
Bạn lại lấy râu ông nọ cắm cằm bà kia rồi.
