62-Module cắt bỏ dấu tiếng Việt và chuyển sang chữ HOA
Option Compare Database
Option Explicit
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcW" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim Mang(13, 17) As String
Sub NapBoDau()
Dim i As Byte, j As Byte, n As Byte
Dim chuoi As String
Dim Thga As String, Thge As String, Thgo As String, Thgu As String, Thgi As String, Thgd As String, Thgy As String
Dim HoaA As String, HoaE As String, HoaO As String, HoaU As String, HoaI As String, HoaD As String, HoaY As String
chuoi = "aAeEoOuUiIdDyY"
Thga = UnicodeChar(";E1;E0;1EA1;1EA3;E3;E2;1EA5;1EA7;1EAD;1EA9;1EAB;103;1EAF;1EB1;1EB7;1EB3;1EB5")
HoaA = UnicodeChar(";C1;C0;1EA0;1EA2;C3;C2;1EA4;1EA6;1EAC;1EA8;1EAA;102;1EAE;1EB0;1EB6;1EB2;1EB4")
Thge = UnicodeChar(";E9;E8;1EB9;1EBB;1EBD;EA;1EBF;1EC1;1EC7;1EC3;1EC5;65;65;65;65;65;65")
HoaE = UnicodeChar(";C9;C8;1EB8;1EBA;1EBC;CA;1EBE;1EC0;1EC6;1EC2;1EC4;45;45;45;45;45;45")
Thgo = UnicodeChar(";F3;F2;1ECD;1ECF;F5;F4;1ED1;1ED3;1ED9;1ED5;1ED7;1A1;1EDB;1EDD;1EE3;1EDF;1EE1")
HoaO = UnicodeChar(";D3;D2;1ECC;1ECE;D5;D4;1ED0;1ED2;1ED8;1ED4;1ED6;1A0;1EDA;1EDC;1EE2;1EDE;1EE0")
Thgu = UnicodeChar(";FA;F9;1EE5;1EE7;169;1B0;1EE9;1EEB;1EF1;1EED;1EEF;75;75;75;75;75;75")
HoaU = UnicodeChar(";DA;D9;1EE4;1EE6;168;1AF;1EE8;1EEA;1EF0;1EEC;1EEE;55;55;55;55;55;55")
Thgi = UnicodeChar(";ED;EC;1ECB;1EC9;129;69;69;69;69;69;69;69;69;69;69;69;69")
HoaI = UnicodeChar(";CD;CC;1ECA;1EC8;128;49;49;49;49;49;49;49;49;49;49;49;49")
Thgd = UnicodeChar(";111;64;64;64;64;64;64;64;64;64;64;64;64;64;64;64;64")
HoaD = UnicodeChar(";110;44;44;44;44;44;44;44;44;44;44;44;44;44;44;44;44")
Thgy = UnicodeChar(";FD;1EF3;1EF5;1EF7;1EF9;79;79;79;79;79;79;79;79;79;79;79;79")
HoaY = UnicodeChar(";DD;1EF2;1EF4;1EF6;1EF8;59;59;59;59;59;59;59;59;59;59;59;59")
For i = 0 To 13
Mang(i, 0) = Mid(chuoi, i + 1, 1)
Next
For j = 1 To 17
For i = 1 To 17
Mang(0, i) = Mid(Thga, i, 1)
Mang(1, i) = Mid(HoaA, i, 1)
Mang(2, i) = Mid(Thge, i, 1)
Mang(3, i) = Mid(HoaE, i, 1)
Mang(4, i) = Mid(Thgo, i, 1)
Mang(5, i) = Mid(HoaO, i, 1)
Mang(6, i) = Mid(Thgu, i, 1)
Mang(7, i) = Mid(HoaU, i, 1)
Mang(8, i) = Mid(Thgi, i, 1)
Mang(9, i) = Mid(HoaI, i, 1)
Mang(10, i) = Mid(Thgd, i, 1)
Mang(11, i) = Mid(HoaD, i, 1)
Mang(12, i) = Mid(Thgy, i, 1)
Mang(13, i) = Mid(HoaY, i, 1)
Next
Next
End Sub
Function UnicodeChar(UniCharCode As String) As String
On Error GoTo er
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
er:
If Len(Error) > 0 Then
MsgBox Error
End If
End Function
Function BoDau(MyText As String) As String
Dim Tam1 As String, Tam2 As String
Dim i As Byte, j As Byte, n As Byte
NapBoDau
Tam1 = MyText
For j = 0 To 13
For i = 1 To 17
Tam2 = Replace(Tam1, Mang(j, i), Mang(j, 0), 1, -1, vbBinaryCompare)
Tam1 = Tam2
Next
Next
BoDau = Tam1
End Function