chuyển font Vntime sang unicode

[vuong1691992.venus]

Chào các bạn trong diễn đàn kế toán
-Mình đang viết 1 module chuyển font .Vntime sang Unicode bằng access,cụ thể là font
Tahoma
Nhưng khi chuyển table của access với font unicode sang excell thì những chữ có dấu bị chuyển thành dấu ? ,Mình cũng chưa biết nguyên nhân làm sao
Mong các bạn giúp đỡ
-Nếu các bạn có code access của đoạn chuyển font đó cho mình xin nhé
-Hiện tại mình vẫn phải chuyển thủ công bằng unikey nên hơi bất tiện
-ai có đoạn code access nào giống unikey cho mình nhé
Xin cám ơn các bạn trước

View more random threads:

• Làm sao để tắt chế độ Read Only khi mở file Access qua mạng Lan ?
• làm cách nào để đưa nhiều file excel vào cùng 1 table
• Các Bro giúp em sử lý hàm Dsum kết hợp hàm And với !!!!
• Nhờ a Phatnq2002 nhặt số liệu từ các table
• Xin hướng dẫn cách nhập số vào textbox
• Update thông tin 1 cầu thủ mới
• Hỏi cách viết 1 hàn function tính điểm TB
• Giúp mình mở file database này với?
• Form Status làm như thế nào anh chị ơi...?
• Lập trình VBA trên Access - hình như ít người để ý

[beprongviet]

Ðề: chuyển font Vntime sang unicode

TCVN3 to Unicode:

Option Explicit

Function ToUnicode(txtString As String, Optional isReversed As Boolean = False, Optional isISO As Boolean = False) As String
' This function will do the conversion of text string into unicode
Dim iStr As String, repTxt As String, mText As String
Dim i As Long, j As Long
Dim iUnicode As Variant ' array to keep unicode char set
Dim iTCVN As Variant ' array to keep TCVN char set
Dim iProcList() As String ' array to keep what to convert

'parse the parameter into this local variable
iStr = txtString
mText = txtString

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, 195, _
258, 194, 212, 416, 431, 272)

iTCVN = Array(184, 181, 182, 183, 185, 168, 190, 187, 188, 189, 198, 169, 202, 199, 200, _
201, 203, 208, 204, 206, 207, 209, 170, 213, 210, 211, 212, 214, 221, 215, 216, 220, _
222, 227, 223, 225, 226, 228, 171, 232, 229, 230, 231, 233, 172, 237, 234, 235, 236, _
238, 243, 239, 241, 242, 244, 173, 248, 245, 246, 247, 249, 253, 250, 251, 252, 254, _
174, 193, 192, 195, 161, 162, 164, 165, 166, 167)

' Reenlarge the array
ReDim iProcList(1, 133)
' process the vowel only and covert to asc code
For i = 1 To Len(mText)
repTxt = Mid(mText, i, 1)
If AscW(repTxt) > 122 Then
iStr = Replace(iStr, repTxt, "[" & AscW(repTxt) & "]")
mText = Replace(mText, repTxt, " ")
' write the processed list
iProcList(1, j) = "[" & AscW(repTxt) & "]"
If isISO Then
iProcList(0, j) = GetElementNo(AscW(repTxt), iUnicode)
Else
If isReversed Then
iProcList(0, j) = GetElementNo(AscW(repTxt), iUnicode)
Else
iProcList(0, j) = GetElementNo(AscW(repTxt), iTCVN)
End If
End If
j = j + 1
End If
Next
If j = 0 Then
ToUnicode = txtString
Exit Function
End If
ReDim Preserve iProcList(1, j - 1)
' now convert to unicode
For i = 0 To UBound(iProcList, 2)
If isReversed Then
iStr = Replace(iStr, iProcList(1, i), ChrW(iTCVN(Val(iProcList(0, i)))))
Else
If isISO Then
iStr = Replace(iStr, iProcList(1, i), "&#" & iUnicode(Val(iProcList(0, i))) & ";")
Else
iStr = Replace(iStr, iProcList(1, i), ChrW(iUnicode(Val(iProcList(0, i)))))
End If
End If
Next
fExit:
ToUnicode = iStr
End Function

Private Function GetElementNo(iTxt As Long, iObj As Variant) As String
Dim i As Long
For i = 0 To UBound(iObj)
If iTxt = iObj(i) Then
GetElementNo = CStr(i)
Exit For
End If
Next
End Function

Để xuất sang Excel không bị lỗi fonts, bạn có thể dùng macro: OutPut to