• Tùy chọn
• Đăng nhập
• Đăng ký
• Xem như trên Máy tính
• Accelerated Mobile Pages Theme

Convert fonts từ TCVN3 sang Unicode và ngược lại

• Trang chủ

  • Thủ Thuật Access
  • Access Nâng Cao
  • Thư viện thủ thuật
  • Convert fonts từ TCVN3 sang Unicode và ngược lại
• Convert fonts từ TCVN3 sang Unicode và ngược lại

• Convert fonts từ TCVN3 sang Unicode và ngược lại

  haquocquan > 18-11-10, 01:55 AM

  Sưu tầm được đoạn code chuyển font từ bảng mã TCVN3 sang UNICODE và ngược lại. Post lên để mọi người tham khảo:
  Copy vào module:
  
  

  Mã:

  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

  
  Chuyển TCVN3 sang Unicode:
  

  Mã:

  ToUnicode(chuoi)

  
  Chuyển Unicode sang TCVN3
  

  Mã:

  ToUnicode(chuoi,true)

  Nguồn: sưu tầm

• RE: Convert fonts từ TCVN3 sang Unicode và ngược lại

  jetly1988 > 16-07-12, 01:01 PM

  cái này dùng để làm gì vậy haquocquan

• RE: Convert fonts từ TCVN3 sang Unicode và ngược lại

  bangnguyencong > 29-11-12, 01:10 AM

  Vậy mình cũng có thể chuyển từ font VNI sang Unicode được chứ? Nếu được thì chuyển thế nào?
  Nhờ haquocquan chỉ giùm.
  Thank!!!!

• RE: Convert fonts từ TCVN3 sang Unicode và ngược lại

  ledangvan > 29-11-12, 11:45 AM

  (29-11-12, 01:10 AM)bangnguyencong Đã viết: Vậy mình cũng có thể chuyển từ font VNI sang Unicode được chứ? Nếu được thì chuyển thế nào?
  Nhờ haquocquan chỉ giùm.
  Thank!!!!

  
  Của bạn đây :
  Option Explicit
  
  Private Function GetVNIMap() As Variant
  ' Break multichar Vowels to an array, original functions was different, but
  ' I make this to fulfill your task only
  Dim i As Integer, j As Integer
  Dim vniArr As Variant
  ' Declare a variable to keep VNI vowel (two dimensions)
  Dim mappedVw(1, 133) As String
  On Error GoTo errmsg
  ' raw string of VNI code table
  vniArr = Array("aù 001", "aø 002", "aû 003", "aõ 004", "aï 005", "aê 006", "aé 007", "aè 008", "aú 009", _
  "aü 010", "aë 011", "aâ 012", "aá 013", "aà 014", "aå 015", "aã 016", "aä 017", "eù 018", "eø 019", "eû 020", "eõ 021", _
  "eï 022", "eâ 023", "eá 024", "eà 025", "eå 026", "eã 027", "eä 028", "í 029", "ì 030", "æ 031", "ó 032", "ò 033", _
  "où 034", "oø 035", "oû 036", "oõ 037", "oï 038", "oâ 039", "oá 040", "oà 041", "oå 042", "oã 043", "oä 044", _
  "ôù 046", "ôø 047", "ôû 048", "ôõ 049", "ôï 050", "uù 051", "uø 052", "uû 053", "uõ 054", "uï 055", "öù 057", _
  "öø 058", "öû 059", "öõ 060", "öï 061", "yù 062", "yø 063", "yû 064", "yõ 065", "î 066", "ñ 067", "AÙ 068", "AØ 069", _
  "AÛ 070", "AÕ 071", "AÏ 072", "AÊ 073", "AÉ 074", "AÈ 075", "AÚ 076", "AÜ 077", "AË 078", "AÂ 079", "AÁ 080", "AÀ 081", _
  "AÅ 082", "AÃ 083", "AÄ 084", "EÙ 085", "EØ 086", "EÛ 087", "EÕ 088", "EÏ 089", "EÂ 090", "EÁ 091", "EÀ 092", "EÅ 093", _
  "EÃ 094", "EÄ 095", "Í 096", "Ì 097", "Æ 098", "Ó 099", "Ò 100", "OÙ 101", "OØ 102", "OÛ 103", "OÕ 104", "OÏ 105", _
  "OÂ 106", "OÁ 107", "OÀ 108", "OÅ 109", "OÃ 110", "OÄ 111", "ÔÙ 113", "ÔØ 114", "ÔÛ 115", "ÔÕ 116", "ÔÏ 117", _
  "UÙ 118", "UØ 119", "UÛ 120", "UÕ 121", "UÏ 122", "ÖÙ 124", "ÖØ 125", "ÖÛ 126", "ÖÕ 127", "ÖÏ 128", "YÙ 129", _
  "YØ 130", "YÛ 131", "YÕ 132", "Î 133", "Ñ 134", "ô 045", "ö 056", "Ô 112", "Ö 123")
  'turn this array to a 2-D array for later mapping through
  For i = LBound(vniArr) To UBound(vniArr)
  j = InStr(vniArr(i), " ")
  mappedVw(0, i) = Trim(Mid(vniArr(i), j))
  mappedVw(1, i) = Trim(Left(vniArr(i), j - 1))
  Next
  GetVNIMap = mappedVw
  
  Exit Function
  errmsg:
  MsgBox Err.Description
  End Function
  
  Function ToUnicode(txtString As String) As String
  ' This function will do the conversion of text string into unicode
  Dim repTxt As String, mText As String
  Dim i As Long, j As Long
  Dim iUnicode As Variant ' array to keep unicode char set
  Dim iVni As Variant
  Dim procList As Variant
  ReDim procList(1, 133)
  ' Here is the source ansi-like of unicode
  iUnicode = Array(225, 224, 7843, 227, 7841, 259, 7855, 7857, 7859, 7861, 7863, 226, 7845, 7847, 7849, _
  7851, 7853, 233, ***, 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)
  
  'parse the parameter into this local variable
  mText = txtString
  
  ' Retrive the code for VNI
  iVni = GetVNIMap
  ' process the input string by replacing all combined multichar to a [123] form
  For i = LBound(iVni, 2) To UBound(iVni, 2)
  If InStr(mText, iVni(1, i)) <> 0 Then
  ' get the unicode approriate ansi number to the chars those will be replace
  repTxt = iUnicode(Val(iVni(0, i)) - 1)
  ' Now replace with unicode ansi char number
  mText = Replace(mText, iVni(1, i), "[" & repTxt & "]")
  procList(0, j) = repTxt
  procList(1, j) = ChrW(repTxt)
  j = j + 1
  End If
  Next
  ReDim Preserve procList(1, j - 1)
  For i = 0 To UBound(procList, 2)
  mText = Replace(mText, "[" & procList(0, i) & "]", procList(1, i))
  Next
  ToUnicode = mText
  End Function
  
  Chúc bạn thành công trong việc học hỏi

• RE: Convert fonts từ TCVN3 sang Unicode và ngược lại

  bangnguyencong > 30-11-12, 03:29 PM

  Oh! Cám ơn bạn nhiều lắm!!!!
  Trân trọng!

• RE: Convert fonts từ TCVN3 sang Unicode và ngược lại

  bangnguyencong > 30-11-12, 04:03 PM

  Đoạn này hình như bị lỗi thì phải.
  iUnicode = Array(225, 224, 7843, 227, 7841, 259, 7855, 7857, 7859, 7861, 7863, 226, 7845, 7847, 7849, _
  7851, 7853, 233, ***, 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)
  Khi chép vào module nó hiện màu đỏ. Khi chạy nó báo lỗi.
  Nhờ bạn xem lại.
  Trân trọng!
  

  ---

  Đây là file thử nghiệm xin gửi bạn.
  http://www.mediafire.com/download.php?gfvd6s5ubg60su8

• Convert fonts từ VNI sang Unicode

  Xuân Thanh > 30-11-12, 05:23 PM

  Mã PHP:

  Function VNItoUNICODE(vnstr As String)
Dim c As String, i As Long
Dim db As Boolean
   For i = 1 To Len(vnstr)
      db = False
      If i < Len(vnstr) Then
         c = Mid(vnstr, i + 1, 1)
         If c = "ù" Or c = "ø" Or c = "û" Or c = "õ" Or c = "ï" Or _
            c = "ê" Or c = "é" Or c = "è" Or c = "ú" Or c = "ü" Or c = "ë" Or _
            c = "â" Or c = "á" Or c = "à" Or c = "å" Or c = "ã" Or c = "ä" Or _
            c = "Ù" Or c = "Ø" Or c = "Û" Or c = "Õ" Or c = "Ï" Or _
            c = "Ê" Or c = "É" Or c = "È" Or c = "Ú" Or c = "Ü" Or c = "Ë" Or _
            c = "Â" Or c = "Á" Or c = "À" Or c = "Å" Or c = "Ã" Or c = "Ä" Then db = True
      End If
      If db Then
         c = Mid(vnstr, i, 2)
         Select Case c
            Case "aù": c = ChrW$(225)
            Case "aø": c = ChrW$(224)
            Case "aû": c = ChrW$(7843)
            Case "aõ": c = ChrW$(227)
            Case "aï": c = ChrW$(7841)
            Case "aê": c = ChrW$(259)
            Case "aé": c = ChrW$(7855)
            Case "aè": c = ChrW$(7857)
            Case "aú": c = ChrW$(7859)
            Case "aü": c = ChrW$(7861)
            Case "aë": c = ChrW$(7863)
            Case "aâ": c = ChrW$(226)
            Case "aá": c = ChrW$(7845)
            Case "aà": c = ChrW$(7847)
            Case "aå": c = ChrW$(7849)
            Case "aã": c = ChrW$(7851)
            Case "aä": c = ChrW$(7853)
            Case "eù": c = ChrW$(233)
            Case "eø": c = ChrW$(232)
            Case "eû": c = ChrW$(7867)
            Case "eõ": c = ChrW$(7869)
            Case "eï": c = ChrW$(7865)
            Case "eâ": c = ChrW$(234)
            Case "eá": c = ChrW$(7871)
            Case "eà": c = ChrW$(7873)
            Case "eå": c = ChrW$(7875)
            Case "eã": c = ChrW$(7877)
            Case "eä": c = ChrW$(7879)
            Case "où": c = ChrW$(243)
            Case "oø": c = ChrW$(242)
            Case "oû": c = ChrW$(7887)
            Case "oõ": c = ChrW$(245)
            Case "oï": c = ChrW$(7885)
            Case "oâ": c = ChrW$(244)
            Case "oá": c = ChrW$(7889)
            Case "oà": c = ChrW$(7891)
            Case "oå": c = ChrW$(7893)
            Case "oã": c = ChrW$(7895)
            Case "oä": c = ChrW$(7897)
            Case "ôù": c = ChrW$(7899)
            Case "ôø": c = ChrW$(7901)
            Case "ôû": c = ChrW$(7903)
            Case "ôõ": c = ChrW$(7905)
            Case "ôï": c = ChrW$(7907)
            Case "uù": c = ChrW$(250)
            Case "uø": c = ChrW$(249)
            Case "uû": c = ChrW$(7911)
            Case "uõ": c = ChrW$(361)
            Case "uï": c = ChrW$(7909)
            Case "öù": c = ChrW$(7913)
            Case "öø": c = ChrW$(7915)
            Case "öû": c = ChrW$(7917)
            Case "öõ": c = ChrW$(7919)
            Case "öï": c = ChrW$(7921)
            Case "yù": c = ChrW$(253)
            Case "yø": c = ChrW$(7923)
            Case "yû": c = ChrW$(7927)
            Case "yõ": c = ChrW$(7929)
            Case "AÙ": c = ChrW$(193)
            Case "AØ": c = ChrW$(192)
            Case "AÛ": c = ChrW$(7842)
            Case "AÕ": c = ChrW$(195)
            Case "AÏ": c = ChrW$(7840)
            Case "AÊ": c = ChrW$(258)
            Case "AÉ": c = ChrW$(7854)
            Case "AÈ": c = ChrW$(7856)
            Case "AÚ": c = ChrW$(7858)
            Case "AÜ": c = ChrW$(7860)
            Case "AË": c = ChrW$(7862)
            Case "AÂ": c = ChrW$(194)
            Case "AÁ": c = ChrW$(7844)
            Case "AÀ": c = ChrW$(7846)
            Case "AÅ": c = ChrW$(7848)
            Case "AÃ": c = ChrW$(7850)
            Case "AÄ": c = ChrW$(7852)
            Case "EÙ": c = ChrW$(201)
            Case "EØ": c = ChrW$(200)
            Case "EÛ": c = ChrW$(7866)
            Case "EÕ": c = ChrW$(7868)
            Case "EÏ": c = ChrW$(7864)
            Case "EÂ": c = ChrW$(202)
            Case "EÁ": c = ChrW$(7870)
            Case "EÀ": c = ChrW$(7872)
            Case "EÅ": c = ChrW$(7874)
            Case "EÃ": c = ChrW$(7876)
            Case "EÄ": c = ChrW$(7878)
            Case "OÙ": c = ChrW$(211)
            Case "OØ": c = ChrW$(210)
            Case "OÛ": c = ChrW$(7886)
            Case "OÕ": c = ChrW$(213)
            Case "OÏ": c = ChrW$(7884)
            Case "OÂ": c = ChrW$(212)
            Case "OÁ": c = ChrW$(7888)
            Case "OÀ": c = ChrW$(7890)
            Case "OÅ": c = ChrW$(7892)
            Case "OÃ": c = ChrW$(7894)
            Case "OÄ": c = ChrW$(7896)
            Case "ÔÙ": c = ChrW$(7898)
            Case "ÔØ": c = ChrW$(7900)
            Case "ÔÛ": c = ChrW$(7902)
            Case "ÔÕ": c = ChrW$(7904)
            Case "ÔÏ": c = ChrW$(7906)
            Case "UÙ": c = ChrW$(218)
            Case "UØ": c = ChrW$(217)
            Case "UÛ": c = ChrW$(7910)
            Case "UÕ": c = ChrW$(360)
            Case "UÏ": c = ChrW$(7908)
            Case "ÖÙ": c = ChrW$(7912)
            Case "ÖØ": c = ChrW$(7914)
            Case "ÖÛ": c = ChrW$(7916)
            Case "ÖÕ": c = ChrW$(7918)
            Case "ÖÏ": c = ChrW$(7920)
            Case "YÙ": c = ChrW$(221)
            Case "YØ": c = ChrW$(7922)
            Case "YÛ": c = ChrW$(7926)
            Case "YÕ": c = ChrW$(7928)
         End Select
      Else
         c = Mid(vnstr, i, 1)
         Select Case c
            Case "ô": c = ChrW$(417)
            Case "í": c = ChrW$(237)
            Case "ì": c = ChrW$(236)
            Case "æ": c = ChrW$(7881)
            Case "ó": c = ChrW$(297)
            Case "ò": c = ChrW$(7883)
            Case "ö": c = ChrW$(432)
            Case "î": c = ChrW$(7925)
            Case "ñ": c = ChrW$(273)
            Case "Ô": c = ChrW$(416)
            Case "Í": c = ChrW$(205)
            Case "Ì": c = ChrW$(204)
            Case "Æ": c = ChrW$(7880)
            Case "Ó": c = ChrW$(296)
            Case "Ò": c = ChrW$(7882)
            Case "Ö": c = ChrW$(431)
            Case "Î": c = ChrW$(7924)
            Case "Ñ": c = ChrW$(272)
         End Select
      End If
      VNItoUNICODE = VNItoUNICODE + c
      If db Then i = i + 1
   Next i
End Function 


  
  P/S : Hàm của OverAC - GPE

• RE: Convert fonts từ VNI sang Unicode

  bangnguyencong > 30-11-12, 05:29 PM

  Ồ quá tuyệt bạn Xuân Thanh ơi!
  Cám ơn bạn nhiều!
  Quả thật là đẳng cấp.

• Convert fonts từ Unicode sang VNI

  Xuân Thanh > 30-11-12, 05:33 PM

  Và đây là điều ngươc lại : Từ UNI chuyển sang VNI
  
  

  Mã PHP:

  Function UNICODEtoVNI(vnstr As String)
Dim c As String, i As Long
   For i = 1 To Len(vnstr)
      c = Mid(vnstr, i, 1)
      Select Case c
         Case ChrW$(97): c = "a"
         Case ChrW$(225): c = "aù"
         Case ChrW$(224): c = "aø"
         Case ChrW$(7843): c = "aû"
         Case ChrW$(227): c = "aõ"
         Case ChrW$(7841): c = "aï"
         Case ChrW$(259): c = "aê"
         Case ChrW$(7855): c = "aé"
         Case ChrW$(7857): c = "aè"
         Case ChrW$(7859): c = "aú"
         Case ChrW$(7861): c = "aü"
         Case ChrW$(7863): c = "aë"
         Case ChrW$(226): c = "aâ"
         Case ChrW$(7845): c = "aá"
         Case ChrW$(7847): c = "aà"
         Case ChrW$(7849): c = "aå"
         Case ChrW$(7851): c = "aã"
         Case ChrW$(7853): c = "aä"
         Case ChrW$(101): c = "e"
         Case ChrW$(233): c = "eù"
         Case ChrW$(232): c = "eø"
         Case ChrW$(7867): c = "eû"
         Case ChrW$(7869): c = "eõ"
         Case ChrW$(7865): c = "eï"
         Case ChrW$(234): c = "eâ"
         Case ChrW$(7871): c = "eá"
         Case ChrW$(7873): c = "eà"
         Case ChrW$(7875): c = "eå"
         Case ChrW$(7877): c = "eã"
         Case ChrW$(7879): c = "eä"
         Case ChrW$(111): c = "o"
         Case ChrW$(243): c = "où"
         Case ChrW$(242): c = "oø"
         Case ChrW$(7887): c = "oû"
         Case ChrW$(245): c = "oõ"
         Case ChrW$(7885): c = "oï"
         Case ChrW$(244): c = "oâ"
         Case ChrW$(7889): c = "oá"
         Case ChrW$(7891): c = "oà"
         Case ChrW$(7893): c = "oå"
         Case ChrW$(7895): c = "oã"
         Case ChrW$(7897): c = "oä"
         Case ChrW$(417): c = "ô"
         Case ChrW$(7899): c = "ôù"
         Case ChrW$(7901): c = "ôø"
         Case ChrW$(7903): c = "ôû"
         Case ChrW$(7905): c = "ôõ"
         Case ChrW$(7907): c = "ôï"
         Case ChrW$(105): c = "i"
         Case ChrW$(237): c = "í"
         Case ChrW$(236): c = "ì"
         Case ChrW$(7881): c = "æ"
         Case ChrW$(297): c = "ó"
         Case ChrW$(7883): c = "ò"
         Case ChrW$(117): c = "u"
         Case ChrW$(250): c = "uù"
         Case ChrW$(249): c = "uø"
         Case ChrW$(7911): c = "uû"
         Case ChrW$(361): c = "uõ"
         Case ChrW$(7909): c = "uï"
         Case ChrW$(432): c = "ö"
         Case ChrW$(7913): c = "öù"
         Case ChrW$(7915): c = "uø"
         Case ChrW$(7917): c = "öû"
         Case ChrW$(7919): c = "öõ"
         Case ChrW$(7921): c = "öï"
         Case ChrW$(121): c = "y"
         Case ChrW$(253): c = "yù"
         Case ChrW$(7923): c = "yø"
         Case ChrW$(7927): c = "yû"
         Case ChrW$(7929): c = "yõ"
         Case ChrW$(7925): c = "î"
         Case ChrW$(273): c = "ñ"
         Case ChrW$(65): c = "A"
         Case ChrW$(193): c = "AÙ"
         Case ChrW$(192): c = "AØ"
         Case ChrW$(7842): c = "AÛ"
         Case ChrW$(195): c = "AÕ"
         Case ChrW$(7840): c = "AÏ"
         Case ChrW$(258): c = "AÊ"
         Case ChrW$(7854): c = "AÉ"
         Case ChrW$(7856): c = "AÈ"
         Case ChrW$(7858): c = "AÚ"
         Case ChrW$(7860): c = "AÜ"
         Case ChrW$(7862): c = "AË"
         Case ChrW$(194): c = "AÂ"
         Case ChrW$(7844): c = "AÁ"
         Case ChrW$(7846): c = "AÀ"
         Case ChrW$(7848): c = "AÅ"
         Case ChrW$(7850): c = "AÃ"
         Case ChrW$(7852): c = "AÄ"
         Case ChrW$(69): c = "E"
         Case ChrW$(201): c = "EÙ"
         Case ChrW$(200): c = "EØ"
         Case ChrW$(7866): c = "EÛ"
         Case ChrW$(7868): c = "EÕ"
         Case ChrW$(7864): c = "EÏ"
         Case ChrW$(202): c = "EÂ"
         Case ChrW$(7870): c = "EÁ"
         Case ChrW$(7872): c = "EÀ"
         Case ChrW$(7874): c = "EÅ"
         Case ChrW$(7876): c = "EÃ"
         Case ChrW$(7878): c = "EÄ"
         Case ChrW$(79): c = "O"
         Case ChrW$(211): c = "OÙ"
         Case ChrW$(210): c = "OØ"
         Case ChrW$(7886): c = "OÛ"
         Case ChrW$(213): c = "OÕ"
         Case ChrW$(7884): c = "OÏ"
         Case ChrW$(212): c = "OÂ"
         Case ChrW$(7888): c = "OÁ"
         Case ChrW$(7890): c = "OÀ"
         Case ChrW$(7892): c = "OÅ"
         Case ChrW$(7894): c = "OÃ"
         Case ChrW$(7896): c = "OÄ"
         Case ChrW$(416): c = "Ô"
         Case ChrW$(7898): c = "ÔÙ"
         Case ChrW$(7900): c = "ÔØ"
         Case ChrW$(7902): c = "ÔÛ"
         Case ChrW$(7904): c = "ÔÕ"
         Case ChrW$(7906): c = "ÔÏ"
         Case ChrW$(73): c = "I"
         Case ChrW$(205): c = "Í"
         Case ChrW$(204): c = "Ì"
         Case ChrW$(7880): c = "Æ"
         Case ChrW$(296): c = "Ó"
         Case ChrW$(7882): c = "Ò"
         Case ChrW$(85): c = "U"
         Case ChrW$(218): c = "UÙ"
         Case ChrW$(217): c = "UØ"
         Case ChrW$(7910): c = "UÛ"
         Case ChrW$(360): c = "UÕ"
         Case ChrW$(7908): c = "UÏ"
         Case ChrW$(431): c = "Ö"
         Case ChrW$(7912): c = "ÖÙ"
         Case ChrW$(7914): c = "ÖØ"
         Case ChrW$(7916): c = "ÖÛ"
         Case ChrW$(7918): c = "ÖÕ"
         Case ChrW$(7920): c = "ÖÏ"
         Case ChrW$(89): c = "Y"
         Case ChrW$(221): c = "YÙ"
         Case ChrW$(7922): c = "YØ"
         Case ChrW$(7926): c = "YÛ"
         Case ChrW$(7928): c = "YÕ"
         Case ChrW$(7924): c = "Î"
         Case ChrW$(272): c = "Ñ"
      End Select
      UNICODEtoVNI = UNICODEtoVNI + c
   Next i
End Function 


• RE: Convert fonts từ TCVN3 sang Unicode và ngược lại

  ledangvan > 23-11-19, 10:38 AM

  (18-11-10, 01:55 AM)haquocquan Đã viết: Sưu tầm được đoạn code chuyển font từ bảng mã TCVN3 sang UNICODE và ngược lại. Post lên để mọi người tham khảo:
  Copy vào module:
  
  

  Mã:

  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

  
  Chuyển TCVN3 sang Unicode:
  

  Mã:

  ToUnicode(chuoi)

  
  Chuyển Unicode sang TCVN3
  

  Mã:

  ToUnicode(chuoi,true)

  Nguồn: sưu tầm

  
  
  Có cách nào chuyển nguyên chữ được không bạn Haquocquan ? Ví dụ : Công ty Trách nhiệm hữu hạn Anh Quốc -> Theo code hiện tại nó sẽ thành : Công ty trách nhiệm hữu hạn anh quốc; hoặc nếu cho chữ đầu to thì nó thành : Công Ty Trách Nhiệm Hữu Hạn Anh Quốc
  
  Hoặc Công ty TNHH Anh Quốc -> Nó đổi thành Công ty tnhh anh quốc hoặc Công Ty Tnhh Anh Quốc
  
  Mình muốn khi đổi :  + Công ty TNHH Anh Quốc khi đỗi vẫn giữ nguyên chữ to : Công ty TNHH Anh Quốc
                                 + Công ty Trách nhiệm hữu hạn Anh Quốc khi đổi vẫn thành : Công ty Trách nhiệm hữu hạn Anh Quốc.
• Bài trước Bài tiếp