Tùy chọn
Hỏi cách đổi Font hàng loạt trên Form ?
- Hỏi cách đổi Font hàng loạt trên Form ?
-
RE: Hỏi cách đổi Font hàng loạt trên Form ?
tranthanhan1962 > 22-08-21, 10:27 AM
(21-08-21, 10:20 PM)paulsteigel Đã viết: Cụ ơi, trong bài viết của Văn thì bạn ý lầm lẫn giữa 2 khái niệm: Bảng mã và font chữ ạ. Bảng mã là mã máy của ký tự được lưu trữ còn font là cách thể hiện ký tự đó ra thiết bị hiển thị.
Nói khó cũng không phải khó, nhưng cũng không phải dễ. Bộ gõ Vietnamese của Window sử dụng phím 0 bên chữ ra chữ đ (shift -> Đ), 1-> ă, 2->â, 3->ê, 4->ô...Nhưng phiền một cái là khi sử dụng bộ gõ Vietnamese thì mất các ký tự: !, @, #, %, {}, []...nên phải chuyển về bộ gõ US mới gõ được các ký tự này. Sự chuyễn qua lại 2 bộ gõ gây rất nhiều phiền phức.
Còn để làm bàn phím chữ việt thì em cho là cũng lắm chuyện lắm ạ. Theo nguyên lý cơ học thì bàn phím máy chữ chữ việt là gõ xong nguyên âm thì gõ mũ và dấu (theo đúng cách mà bảng mã VIQR thiết lập). E đã từng gõ máy chữ hồi 1999 (cả điện tử và cơ) em nắm được rùi ợ. Nó cũng không có nhiều vấn đề mấy nhưng vấn đề là phải đổi cách gõ thói quen mà người dùng đang dùng ạ.
+ Người Nam thì hay gõ kiểu VNI
+ Người Bắc gõ kiểu telex
+ Người Việt ở nước ngoài hay gõ kiểu VIQR >> gõ đến đâu bỏ dấu đến đó luôn ạ.
Nếu trên bàn phím có thiết kế sẵn các phím trên thì không cần chuyển bộ gõ là OK ngay.Vấn đề thói quen thì không quan trọng. Sử dụng nhiều thành quen. Hồi còn dạy bằng A. Tôi sử dụng VNI, Telex bình thường (biết hết để dạy cho học viên mà). Giờ xài win 10 - wn 11 thì dùng bộ gõ Vietnamese của windows luôn (khỏi cài vietkey, unikey đồng thời sử dụng combobox cũng dễ).
Vấn đề quan trọng trong việc thiết kế là bố trí phím của bàn phím hợp lý. -
RE: Hỏi cách đổi Font hàng loạt trên Form ?
ongke0711 > 22-08-21, 01:08 PM
(21-08-21, 11:37 PM)paulsteigel Đã viết: Ông Kẹ ơi, Đó là do chế độ hiển thị font trong grid của Access 2003 nó không hỗ trợ mỗi cột một font. Hãy thiết kế 1 form thì em sẽ thấy nó ok. Em xem hình nhé
Ngồi kiểm tra sáng giờ mới phát hiện ra lỗi.
Bỏ cái "Option Compare Database" trong module chứa hàm thì hàm chuyển đổi đúng hoàn toàn. -
RE: Hỏi cách đổi Font hàng loạt trên Form ?
paulsteigel > 22-08-21, 04:07 PM
(22-08-21, 01:08 PM)ongke0711 Đã viết:
(21-08-21, 11:37 PM)paulsteigel Đã viết: Ông Kẹ ơi, Đó là do chế độ hiển thị font trong grid của Access 2003 nó không hỗ trợ mỗi cột một font. Hãy thiết kế 1 form thì em sẽ thấy nó ok. Em xem hình nhé
Ngồi kiểm tra sáng giờ mới phát hiện ra lỗi.
Bỏ cái "Option Compare Database" trong module chứa hàm thì hàm chuyển đổi đúng hoàn toàn.
Tớ không dùng cái module cũ của Ông kẹ mà chuyển vào một module mới. Cái chỉ dẫn option compare... đó là chỉ dẫn về kiểu so sánh chuỗi trong khối chương trình. Thường mình toàn bỏ đi mà chỉ dùng option explicit để debug thui! -
RE: Hỏi cách đổi Font hàng loạt trên Form ?
paulsteigel > 22-08-21, 06:21 PM
(22-08-21, 01:08 PM)ongke0711 Đã viết: ......
Ngồi kiểm tra sáng giờ mới phát hiện ra lỗi.
Bỏ cái "Option Compare Database" trong module chứa hàm thì hàm chuyển đổi đúng hoàn toàn.
Ông Kẹ lười nên tôi làm luôn thành một bộ đầy đủ. Giờ chỉ cần gọi ConvertTables([tham số cách chuyển - mặc định là từ TCVN sang Uinocde])
Cách làm như sau, tạo một module và thêm đoạn code sau vào, chọn thủ tục Convertable bấm F5 chạy là xong ợ.
Chúc các Cụ coding vui vẻ
Mã PHP:Option Explicit
Public Enum ConvertType
TCVN2Unicode = 0
VNIWIN2Unicode = 1
Unicode2TCVN = 2
Unicode2VNIWin = 3
VNI2TCVN = 4
TCVN2VNI = 5
End Enum
Private IsInitialised As Boolean ' bien nay dung de khong can phai tai lai cac chuoi so sanh nua
Dim iUnicode As Variant ' array to keep unicode char set
Dim iTCVN As Variant ' array to keep TCVN char set
Dim iVNI As Variant ' array to keep TCVN char set
Sub ConvertTables(Optional Direction As ConvertType = TCVN2Unicode)
' Mo bang va chi chuyen ma doi voi cac truong kieu text
Dim Sql As String, i As Long
Dim FldStr As String
Dim tbl As TableDef
For Each tbl In CurrentDb.TableDefs
If (tbl.Attributes And dbSystemObject) <> 0 Then
' Bang hethong, bo qua
Else
' Okie bang thong thuong
FldStr = "" ' Xoa bien ve null
For i = 0 To tbl.Fields.Count - 1
'Debug.Print tbl.Name & ": " & tbl.Fields(i).Name & ": " & tbl.Fields(i).Type
If InStr("10,12", tbl.Fields(i).Type) > 0 Then ' Kiem tra kieu truong
' day la truong Text, memo, lap chuoi thuc hien
FldStr = FldStr & ", a.[" & tbl.Fields(i).Name & "] = ConvertText(a.[" & tbl.Fields(i).Name & "]," & Direction & ")"
End If
Next
FldStr = Mid(FldStr, 2) ' loai bo dau phay ","
Sql = "UPDATE " & tbl.Name & " AS a SET " & FldStr & ";"
'Debug.Print Sql
' run querry....
CurrentDb.Execute Sql
End If
Next
End Sub
Function VowelsToArray(CharVowels As String, Optional MuliChartype As Boolean = True) As Variant
' Put the multichar Vowels to an array
On Error GoTo errmsg
Dim i As Integer, j As Integer, mText As String '
Dim mTmpArr As Variant
' Send the text into an Array of 134 items
mText = CharVowels
If MuliChartype = True Then ' this is a multchar list
mTmpArr = Split(CharVowels, "/")
Else ' this is a single char
mTmpArr = Array(133)
For i = 1 To Len(mText)
' now extracting the list
mTmpArr(i - 1) = Mid(mText, i, 1) & CStr(i)
Next
End If
VowelsToArray = mTmpArr
Exit Function
errmsg:
MsgBox Err.Description & " " & j & Len(mText) & "//" & mText & "//"
End Function
Function GetUnicodeString() As String
' This function is no longer kept but I still would like it to be here for some folks if they want to diggest
Dim iUnicode As Variant ' array to keep unicode char set
Dim i As Long, iStr As String
iUnicode = 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)
For i = 0 To UBound(iUnicode)
iStr = iStr & "/" & ChrW(iUnicode(i))
Next
GetUnicodeString = Mid(iStr, 2)
End Function
Function ConvertText(txtString As String, Optional CodePage As ConvertType = 0) As String
' ham nay cho phep chuyen lan nhau tu Unicode sang VNI Windows, TCVN va nguoc lai - 6 cach chuyen
If txtString = "" Then
ConvertText = "''"
Exit Function
End If
Dim iStr As String, ProcStr As String, RevList As String
Dim i As Long, ElmNum As Long
Dim ProcList As Variant, ProcVar As Variant, SeedVar As Variant
Dim RevArr As Variant
Dim MultiChar As Boolean
iStr = txtString
If Not IsInitialised Then
IsInitialised = True
iUnicode = VowelsToArray(GetUnicodeString())
iVNI = VowelsToArray("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Õ/Î/Ñ")
iTCVN = VowelsToArray("¸/µ/¶/·/¹/¨/¾/»/¼/½/Æ/©/Ê/Ç/È/É/Ë/Ð/Ì/Î/Ï/Ñ/ª/Õ/Ò/Ó/Ô/Ö/Ý/×/Ø/Ü/Þ/ã/ß/" & _
"á/â/ä/«/è/å/æ/ç/é/¬/í/ê/ë/ì/î/ó/ï/ñ/ò/ô//ø/õ/ö/÷/ù/ý/ú/û/ü/þ/®/¸/µ/¶/·/¹/¡/¾/»/¼/½/Æ/¢/Ê/" & _
"Ç/È/É/Ë/Ð/Ì/Î/Ï/Ñ/£/Õ/Ò/Ó/Ô/Ö/Ý/×/Ø/Ü/Þ/ã/ß/á/â/ä/¤/è/å/æ/ç/é/¥/í/ê/ë/ì/î/ó/ï/ñ/ò/ô/¦/ø/õ/ö" & _
"/÷/ù/ý/ú/û/ü/þ/§")
End If
' Chon cach chuyen dua vao tham so
Select Case CodePage
Case 0: 'Tu TCVN sang Unicode
SeedVar = iTCVN
ProcVar = iUnicode
Case 1: 'Tu VNI san Unicode
SeedVar = iVNI
ProcVar = iUnicode
Case 2: 'Tu Unicode san TCVN
SeedVar = iUnicode
ProcVar = iTCVN
Case 3: 'Tu Unicode sang VNI
SeedVar = iUnicode
ProcVar = iVNI
Case 4: 'Tu VNI sang TCVN
SeedVar = iVNI
ProcVar = iTCVN
Case 5: 'Tu TCVN sang VNI
SeedVar = iTCVN
ProcVar = iVNI
End Select
MultiChar = IIf(Len(SeedVar(i)) > 1, True, False)
' Diem yeu cua cach nay la luon chay qua 133 lenh cua bang ma tieng viet
' Dau tien chuyen cac chuoi ma co 2 ky tu truoc de tranh viec chuyen lap 2 lan
For i = 0 To UBound(SeedVar)
If MultiChar And Len(SeedVar(i)) = 1 Then
' Ok day la chuoi 1 ky tu trong bang ma 2 byte, bo qua, va ghi lai so thu tu cua no
RevList = RevList & "," & i
Else
If InStr(iStr, SeedVar(i)) > 0 Then
'Chi chuyen neu tim thay ky tu
iStr = Replace(iStr, SeedVar(i), "[[" & i & "]]")
ProcStr = ProcStr & ",[[" & i & "]]"
End If
End If
Next
' Thuc hien chuyen sang chuoi trung gian voi phan con lai
RevArr = Split(RevList, ",")
For i = 0 To UBound(RevArr)
ElmNum = Val(RevArr(i))
If InStr(iStr, SeedVar(ElmNum)) > 0 Then
'chi chuyen ma neu tim thay co doan chuoi tim duoc
iStr = Replace(iStr, SeedVar(ElmNum), "[[" & ElmNum & "]]")
ProcStr = ProcStr & ",[[" & ElmNum & "]]"
End If
Next
ProcList = Split(ProcStr, ",")
' Gio chuyen nguoc lai bang ma chuan
For i = 0 To UBound(ProcList)
If ProcList(i) <> "" Then
ElmNum = Val(Mid(ProcList(i), 3))
iStr = Replace(iStr, ProcList(i), ProcVar(ElmNum))
End If
Next
' gio phai loai bo cac loi ky tu trong chuoi vi du dau "'" co the làm SQL bi loi
ConvertText = iStr 'Replace(iStr, "'", "''")
End Function -
RE: Hỏi cách đổi Font hàng loạt trên Form ?
ongke0711 > 22-08-21, 07:53 PM
(22-08-21, 06:21 PM)paulsteigel Đã viết:
Mã PHP:Option Explicit
..
For i = 0 To tbl.Fields.Count - 1
'Debug.Print tbl.Name & ": " & tbl.Fields(i).Name & ": " & tbl.Fields(i).Type
If InStr("10,12", tbl.Fields(i).Type) > 0 Then ' Kiem tra kieu truong
...
- Trong việc chỉ chọn field Text, Memo để chuyển đổi thì do có nhiều bảng có field PK cũng dạng Text nên khi chạy Update sẽ bị báo lỗi do có Relationship với các table khác. Do đó em có thêm đoạn code để liệt kê tất cả các field dạng Text và vừa là field Index để thêm vào câu lệnh Instr(...) ở trên.
Mã PHP:Function getIndexField(sTblName As String) As String
Dim db As DAO.Database
Dim td As DAO.TableDef, idxLoop As Index
Set db = DBEngine(0)(0)
Set td = db.TableDefs(sTblName)
For Each idxLoop In td.Indexes
getIndexField = getIndexField & idxLoop.Fields & ","
If idxLoop.Primary = True Then
'getPKField = Mid(idxLoop.Fields, 2)
'Exit For
End If
Next idxLoop
db.Close
Set db = Nothing
End Function
- Nếu anh có bộ code convert từ Unicode tổ hợp sang Unicode dựng sẳn thì chia sẽ luôn nhé vì cũng cần thêm cách chuyển đổi này. Vụ này gặp khi dùng trong các Form tìm kiếm. Khi bảng dữ liệu nhiều người nhập, có người nhập với bảng mã "dựng sẳn", có người thì không để ý, cứ để mã dạng "tổ hợp". Khi nhập từ khoá tìm kiếm với unicode tổ hợp thì dữ liệu trả về sẽ bị thiếu khi so sánh chuỗi. -
RE: Hỏi cách đổi Font hàng loạt trên Form ?
paulsteigel > 22-08-21, 08:36 PM
(22-08-21, 07:53 PM)ongke0711 Đã viết:
(22-08-21, 06:21 PM)paulsteigel Đã viết:
Mã PHP:Option Explicit
..
For i = 0 To tbl.Fields.Count - 1
'Debug.Print tbl.Name & ": " & tbl.Fields(i).Name & ": " & tbl.Fields(i).Type
If InStr("10,12", tbl.Fields(i).Type) > 0 Then ' Kiem tra kieu truong
...
- Trong việc chỉ chọn field Text, Memo để chuyển đổi thì do có nhiều bảng có field PK cũng dạng Text nên khi chạy Update sẽ bị báo lỗi do có Relationship với các table khác. Do đó em có thêm đoạn code để liệt kê tất cả các field dạng Text và vừa là field Index để thêm vào câu lệnh Instr(...) ở trên.
Mã PHP:Function getIndexField(sTblName As String) As String
Dim db As DAO.Database
Dim td As DAO.TableDef, idxLoop As Index
Set db = DBEngine(0)(0)
Set td = db.TableDefs(sTblName)
For Each idxLoop In td.Indexes
getIndexField = getIndexField & idxLoop.Fields & ","
If idxLoop.Primary = True Then
'getPKField = Mid(idxLoop.Fields, 2)
'Exit For
End If
Next idxLoop
db.Close
Set db = Nothing
End Function
- Nếu anh có bộ code convert từ Unicode tổ hợp sang Unicode dựng sẳn thì chia sẽ luôn nhé vì cũng cần thêm cách chuyển đổi này. Vụ này gặp khi dùng trong các Form tìm kiếm. Khi bảng dữ liệu nhiều người nhập, có người nhập với bảng mã "dựng sẳn", có người thì không để ý, cứ để mã dạng "tổ hợp". Khi nhập từ khoá tìm kiếm với unicode tổ hợp thì dữ liệu trả về sẽ bị thiếu khi so sánh chuỗi.
Okie, phải thế chứ, không được lười nhá! Cảm ơn Ông Kẹ, hy vọng mọi người sẽ có thể sử dụng được công cụ này (chả biết có ai cần dùng nó không nữa hehe - ngoài ông Văn nhà ta) -
RE: Hỏi cách đổi Font hàng loạt trên Form ?
paulsteigel > 22-08-21, 10:24 PM
Đây ông kẹ ơi, bổ sung tổ hợp sang unicode và ngược lại nè
Các phần chính không khác nhau, chỉ bổ sung đoạn khai báo tổ hợp mã của Unicode tổ hợp, tôi định viết lại thủ tục đổi mã cho gọn hơn nhưng chắc chả ai dùng nên thế thôi vậy!
Cái ông Unicode tổ hợp có khác biệt tí, giống như Vni nó dùng các ký tự dấu cho nguyên âm. ví dụ á = a + ký tự dấu 769 (săc).Mã PHP:iUniCp = Code2Char("97,769/97,768/97,777/97,771/97,803/259/259,769/259,768/259,777/259,771/259,803/" & _
"226/226,769/226,768/226,777/226,771/226,803/101,769/101,768/101,777/101,771/101,803/234/234,769/" & _
"234,768/234,777/234,771/234,803/105,769/105,768/105,777/105,771/105,803/111,769/111,768/111,777/" & _
"111,771/111,803/244/244,769/244,768/244,777/244,771/244,803/417/417,769/417,768/417,777/417,771/" & _
"417,803/117,769/117,768/117,777/117,771/117,803/432/432,769/432,768/432,777/432,771/432,803/121,769/" & _
"121,768/121,777/121,771/121,803/273/65,769/65,768/65,777/65,771/65,803/258/258,769/258,768/258,777/" & _
"258,771/258,803/194/194,769/194,768/194,777/194,771/194,803/69,769/69,768/69,777/69,771/69,803/202/" & _
"202,769/202,768/202,777/202,771/202,803/73,769/73,768/73,777/73,771/73,803/79,769/79,768/79,777/" & _
"79,771/79,803/212/212,769/212,768/212,777/212,771/212,803/416/416,769/416,768/416,777/416,771/" & _
"416,803/85,769/85,768/85,777/85,771/85,803/431/431,769/431,768/431,777/431,771/431,803/89,769/" & _
"89,768/89,777/89,771/89,803/272")
Các dấu có code như sau huyền(768), sắc(769), nặng(803), hỏi(777), ngã(771)
Hình dưới đây là sự khác biệt giữa code tổ hợp và dựng sẵn nếu dùng font unicode và font 1byteMã PHP:Option Explicit
Public Enum ConvertType
TCVN2Unicode = 0
VNIWIN2Unicode = 1
Unicode2TCVN = 2
Unicode2VNIWin = 3
VNI2TCVN = 4
TCVN2VNI = 5
UniCp2Uni = 6
Uni2UniCp = 7
End Enum
Private IsInitialised As Boolean ' bien nay dung de khong can phai tai lai cac chuoi so sanh nua
Dim iUnicode As Variant ' array to keep unicode char set
Dim iTCVN As Variant ' array to keep TCVN char set
Dim iVNI As Variant ' array to keep TCVN char set
Dim iUniCp As Variant
Sub ConvertTables(Optional Direction As ConvertType = TCVN2Unicode)
' Mo bang va chi chuyen ma doi voi cac truong kieu text
Dim Sql As String, i As Long
Dim FldStr As String
Dim tbl As TableDef
For Each tbl In CurrentDb.TableDefs
If (tbl.Attributes And dbSystemObject) <> 0 Then
' Bang hethong, bo qua
Else
' Okie bang thong thuong
FldStr = "" ' Xoa bien ve null
For i = 0 To tbl.Fields.Count - 1
'Debug.Print tbl.Name & ": " & tbl.Fields(i).Name & ": " & tbl.Fields(i).Type
If InStr("10,12", tbl.Fields(i).Type) > 0 Then ' Kiem tra kieu truong
' day la truong Text, memo, lap chuoi thuc hien
FldStr = FldStr & ", a.[" & tbl.Fields(i).Name & "] = ConvertText(a.[" & tbl.Fields(i).Name & "]," & Direction & ")"
End If
Next
FldStr = Mid(FldStr, 2) ' loai bo dau phay ","
Sql = "UPDATE " & tbl.Name & " AS a SET " & FldStr & ";"
'Debug.Print Sql
' run querry....
CurrentDb.Execute Sql
End If
Next
End Sub
Function VowelsToArray(CharVowels As String, Optional MuliChartype As Boolean = True) As Variant
' Put the multichar Vowels to an array
On Error GoTo errmsg
Dim i As Integer, j As Integer, mText As String '
Dim mTmpArr As Variant
' Send the text into an Array of 134 items
mText = CharVowels
If MuliChartype = True Then ' this is a multchar list
mTmpArr = Split(CharVowels, "/")
Else ' this is a single char
mTmpArr = Array(133)
For i = 1 To Len(mText)
' now extracting the list
mTmpArr(i - 1) = Mid(mText, i, 1) & CStr(i)
Next
End If
VowelsToArray = mTmpArr
Exit Function
errmsg:
MsgBox Err.Description & " " & j & Len(mText) & "//" & mText & "//"
End Function
Function GetUnicodeString() As String
' This function is no longer kept but I still would like it to be here for some folks if they want to diggest
Dim iUnicode As Variant ' array to keep unicode char set
Dim i As Long, iStr As String
iUnicode = 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)
For i = 0 To UBound(iUnicode)
iStr = iStr & "/" & ChrW(iUnicode(i))
Next
GetUnicodeString = Mid(iStr, 2)
End Function
Private Function Code2Char(txt As String) As Variant
' for converting code to char
Dim Arr1 As Variant, Arr2 As Variant, Arr3(133) As String
Dim i As Long, j As Long, Str As String
Arr1 = Split(txt, "/")
For i = 0 To UBound(Arr1)
Str = ""
Arr2 = Split(Arr1(i), ",")
For j = 0 To UBound(Arr2)
Str = Str & ChrW(Arr2(j))
Next
Arr3(i) = Str
Next
Code2Char = Arr3
End Function
Function ConvertText(txtString As String, Optional CodePage As ConvertType = 0) As String
' ham nay cho phep chuyen lan nhau tu Unicode sang VNI Windows, TCVN va nguoc lai - 6 cach chuyen
If txtString = "" Then
ConvertText = "''"
Exit Function
End If
Dim iStr As String, ProcStr As String, RevList As String
Dim i As Long, ElmNum As Long
Dim ProcList As Variant, ProcVar As Variant, SeedVar As Variant
Dim RevArr As Variant
Dim MultiChar As Boolean
iStr = txtString
If Not IsInitialised Then
IsInitialised = True
iUnicode = VowelsToArray(GetUnicodeString())
iVNI = VowelsToArray("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Õ/Î/Ñ")
iTCVN = VowelsToArray("¸/µ/¶/·/¹/¨/¾/»/¼/½/Æ/©/Ê/Ç/È/É/Ë/Ð/Ì/Î/Ï/Ñ/ª/Õ/Ò/Ó/Ô/Ö/Ý/×/Ø/Ü/Þ/ã/ß/" & _
"á/â/ä/«/è/å/æ/ç/é/¬/í/ê/ë/ì/î/ó/ï/ñ/ò/ô//ø/õ/ö/÷/ù/ý/ú/û/ü/þ/®/¸/µ/¶/·/¹/¡/¾/»/¼/½/Æ/¢/Ê/" & _
"Ç/È/É/Ë/Ð/Ì/Î/Ï/Ñ/£/Õ/Ò/Ó/Ô/Ö/Ý/×/Ø/Ü/Þ/ã/ß/á/â/ä/¤/è/å/æ/ç/é/¥/í/ê/ë/ì/î/ó/ï/ñ/ò/ô/¦/ø/õ/ö" & _
"/÷/ù/ý/ú/û/ü/þ/§")
iUniCp = Code2Char("97,769/97,768/97,777/97,771/97,803/259/259,769/259,768/259,777/259,771/259,803/" & _
"226/226,769/226,768/226,777/226,771/226,803/101,769/101,768/101,777/101,771/101,803/234/234,769/" & _
"234,768/234,777/234,771/234,803/105,769/105,768/105,777/105,771/105,803/111,769/111,768/111,777/" & _
"111,771/111,803/244/244,769/244,768/244,777/244,771/244,803/417/417,769/417,768/417,777/417,771/" & _
"417,803/117,769/117,768/117,777/117,771/117,803/432/432,769/432,768/432,777/432,771/432,803/121,769/" & _
"121,768/121,777/121,771/121,803/273/65,769/65,768/65,777/65,771/65,803/258/258,769/258,768/258,777/" & _
"258,771/258,803/194/194,769/194,768/194,777/194,771/194,803/69,769/69,768/69,777/69,771/69,803/202/" & _
"202,769/202,768/202,777/202,771/202,803/73,769/73,768/73,777/73,771/73,803/79,769/79,768/79,777/" & _
"79,771/79,803/212/212,769/212,768/212,777/212,771/212,803/416/416,769/416,768/416,777/416,771/" & _
"416,803/85,769/85,768/85,777/85,771/85,803/431/431,769/431,768/431,777/431,771/431,803/89,769/" & _
"89,768/89,777/89,771/89,803/272")
End If
' Chon cach chuyen dua vao tham so
Select Case CodePage
Case 0: 'Tu TCVN sang Unicode
SeedVar = iTCVN
ProcVar = iUnicode
Case 1: 'Tu VNI san Unicode
SeedVar = iVNI
ProcVar = iUnicode
Case 2: 'Tu Unicode san TCVN
SeedVar = iUnicode
ProcVar = iTCVN
Case 3: 'Tu Unicode sang VNI
SeedVar = iUnicode
ProcVar = iVNI
Case 4: 'Tu VNI sang TCVN
SeedVar = iVNI
ProcVar = iTCVN
Case 5: 'Tu TCVN sang VNI
SeedVar = iTCVN
ProcVar = iVNI
Case 6: 'Tu Unicp sang Unicode
' forward conversion by default
SeedVar = iUniCp
ProcVar = iUnicode
Case 7: 'Tu Unicode sang Unicp
SeedVar = iUnicode
ProcVar = iUniCp
End Select
MultiChar = IIf(Len(SeedVar(i)) > 1, True, False)
' Diem yeu cua cach nay la luon chay qua 133 lenh cua bang ma tieng viet
' Dau tien chuyen cac chuoi ma co 2 ky tu truoc de tranh viec chuyen lap 2 lan
For i = 0 To UBound(SeedVar)
If MultiChar And Len(SeedVar(i)) = 1 Then
' Ok day la chuoi 1 ky tu trong bang ma 2 byte, bo qua, va ghi lai so thu tu cua no
RevList = RevList & "," & i
Else
If InStr(iStr, SeedVar(i)) > 0 Then
'Chi chuyen neu tim thay ky tu
iStr = Replace(iStr, SeedVar(i), "[[" & i & "]]")
ProcStr = ProcStr & ",[[" & i & "]]"
End If
End If
Next
' Thuc hien chuyen sang chuoi trung gian voi phan con lai
RevArr = Split(RevList, ",")
For i = 0 To UBound(RevArr)
ElmNum = Val(RevArr(i))
If InStr(iStr, SeedVar(ElmNum)) > 0 Then
'chi chuyen ma neu tim thay co doan chuoi tim duoc
iStr = Replace(iStr, SeedVar(ElmNum), "[[" & ElmNum & "]]")
ProcStr = ProcStr & ",[[" & ElmNum & "]]"
End If
Next
ProcList = Split(ProcStr, ",")
' Gio chuyen nguoc lai bang ma chuan
For i = 0 To UBound(ProcList)
If ProcList(i) <> "" Then
ElmNum = Val(Mid(ProcList(i), 3))
iStr = Replace(iStr, ProcList(i), ProcVar(ElmNum))
End If
Next
' gio phai loai bo cac loi ky tu trong chuoi vi du dau "'" co the làm SQL bi loi
ConvertText = iStr 'Replace(iStr, "'", "''")
End Function -
RE: Hỏi cách đổi Font hàng loạt trên Form ?
ledangvan > 23-08-21, 12:00 AM
Trân thành cảm ơn Ongke0711 và bạn Paulsteigel (viết mà cũng đau cả mồm với tên của bạn
) Thực sự là kiến thức mênh mông ... Một lần nữa cảm ơn diễn đàn và cảm ơn các bạn đã nhiệt tình giúp đỡ.
-
RE: Hỏi cách đổi Font hàng loạt trên Form ?
paulsteigel > 23-08-21, 09:31 AM
(23-08-21, 12:00 AM)ledangvan Đã viết: Trân thành cảm ơn Ongke0711 và bạn Paulsteigel (viết mà cũng đau cả mồm với tên của bạn
) Thực sự là kiến thức mênh mông ... Một lần nữa cảm ơn diễn đàn và cảm ơn các bạn đã nhiệt tình giúp đỡ.
hehe - thế thì cụ cứ gọi em là Ngọc cho xong tội - đùa thế chứ cái nick thì nó hơi vớ vẩn tí, nó gắn với thời giai trẻ và tềnh yêu tình củm các kiểu giề đó! Nói thật với cụ trên mạng các kiểu nick toàn dư vại cả à!