Function UniVBA và MsgUni hỗ trợ nhập tiếng việt (Font Unicode) trong VBA

Liên hệ QC
hoangdanh282vn

hoangdanh282vn

Nguyễn Cảnh Hoàng Danh
Thành viên danh dự
Tham gia
21/12/07
Bài viết
1,901
Được thích
5,297
Nghề nghiệp
Kinh doanh các mặt hàng văn phòng phẩm
Gửi các bạn 2 hàm chuyển đổi, hỗ trợ nhập tiếng việt trực tiếp trong VBA.

1. Hàm UniVBA(Str)

UniVBA("Nguye64n Ca3nh Hoa2ng Danh") = "Nguyễn Cảnh Hoàng Danh"
PHP: 
Public Function UniVBA(Str As String) As String
Dim Ma As String, MaLuu As String, i As Long, a As Long
a = 1
For i = a To Len(Str)
i = a
Ma = Mid(Str, i, 3)
MaLuu = Ma
Select Case Ma
    Case "a81": Ma = ChrW(7855):     Case "A81": Ma = ChrW(7854)
    Case "a82": Ma = ChrW(7857):     Case "A82": Ma = ChrW(7856)
    Case "a83": Ma = ChrW(7859):     Case "A83": Ma = ChrW(7858)
    Case "a84": Ma = ChrW(7861):     Case "A84": Ma = ChrW(7860)
    Case "a85": Ma = ChrW(7863):     Case "A85": Ma = ChrW(7862)
    Case "a61": Ma = ChrW(7845):     Case "A61": Ma = ChrW(7844)
    Case "a62": Ma = ChrW(7847):     Case "A62": Ma = ChrW(7846)
    Case "a63": Ma = ChrW(7849):     Case "A63": Ma = ChrW(7848)
    Case "a64": Ma = ChrW(7851):     Case "A64": Ma = ChrW(7850)
    Case "a65": Ma = ChrW(7853):     Case "A65": Ma = ChrW(7852)
    Case "e61": Ma = ChrW(7871):     Case "E61": Ma = ChrW(7870)
    Case "e62": Ma = ChrW(7873):     Case "E62": Ma = ChrW(7872)
    Case "e63": Ma = ChrW(7875):     Case "E63": Ma = ChrW(7874)
    Case "e64": Ma = ChrW(7877):     Case "E64": Ma = ChrW(7876)
    Case "e65": Ma = ChrW(7879):     Case "E65": Ma = ChrW(7878)
    Case "o61": Ma = ChrW(7889):     Case "O61": Ma = ChrW(7888)
    Case "o62": Ma = ChrW(7891):     Case "O62": Ma = ChrW(7890)
    Case "o63": Ma = ChrW(7893):     Case "O63": Ma = ChrW(7892)
    Case "o64": Ma = ChrW(7895):     Case "O64": Ma = ChrW(7894)
    Case "o65": Ma = ChrW(7897):     Case "O65": Ma = ChrW(7896)
    Case "o71": Ma = ChrW(7899):     Case "O71": Ma = ChrW(7898)
    Case "o72": Ma = ChrW(7901):     Case "O72": Ma = ChrW(7900)
    Case "o73": Ma = ChrW(7903):     Case "O73": Ma = ChrW(7902)
    Case "o74": Ma = ChrW(7905):     Case "O74": Ma = ChrW(7904)
    Case "o75": Ma = ChrW(7907):     Case "O75": Ma = ChrW(7906)
    Case "u71": Ma = ChrW(7913):     Case "U71": Ma = ChrW(7912)
    Case "u72": Ma = ChrW(7915):     Case "U72": Ma = ChrW(7914)
    Case "u73": Ma = ChrW(7917):     Case "U73": Ma = ChrW(7916)
    Case "u74": Ma = ChrW(7919):     Case "U74": Ma = ChrW(7918)
    Case "u75": Ma = ChrW(7921):     Case "U75": Ma = ChrW(7920)
End Select
If Ma <> MaLuu Then
    UniVBA = UniVBA & Ma
    a = i + 3
Else
    Ma = Mid(Str, i, 2)
    MaLuu = Ma
    Select Case Ma
        Case "a1": Ma = ChrW(225):     Case "A1": Ma = ChrW(193)
        Case "a2": Ma = ChrW(224):     Case "A2": Ma = ChrW(192)
        Case "a3": Ma = ChrW(7843):    Case "A3": Ma = ChrW(7842)
        Case "a4": Ma = ChrW(227):     Case "A4": Ma = ChrW(195)
        Case "a5": Ma = ChrW(7841):    Case "A5": Ma = ChrW(7840)
        Case "a8": Ma = ChrW(259):     Case "A8": Ma = ChrW(258)
        Case "a6": Ma = ChrW(226):     Case "A6": Ma = ChrW(194)
        Case "d9": Ma = ChrW(273):     Case "D9": Ma = ChrW(272)
        Case "e1": Ma = ChrW(233):     Case "E1": Ma = ChrW(201)
        Case "e2": Ma = ChrW(232):     Case "E2": Ma = ChrW(200)
        Case "e3": Ma = ChrW(7867):    Case "E3": Ma = ChrW(7866)
        Case "e4": Ma = ChrW(7869):    Case "E4": Ma = ChrW(7868)
        Case "e5": Ma = ChrW(7865):    Case "E5": Ma = ChrW(7864)
        Case "e6": Ma = ChrW(234):     Case "E6": Ma = ChrW(202)
        Case "i1": Ma = ChrW(237):     Case "I1": Ma = ChrW(205)
        Case "i2": Ma = ChrW(236):     Case "I2": Ma = ChrW(204)
        Case "i3": Ma = ChrW(7881):    Case "I3": Ma = ChrW(7880)
        Case "i4": Ma = ChrW(297):     Case "I4": Ma = ChrW(296)
        Case "i5": Ma = ChrW(7883):    Case "I5": Ma = ChrW(7882)
        Case "o1": Ma = ChrW(243):     Case "O1": Ma = ChrW(211)
        Case "o2": Ma = ChrW(242):     Case "O2": Ma = ChrW(210)
        Case "o3": Ma = ChrW(7887):    Case "O3": Ma = ChrW(7886)
        Case "o4": Ma = ChrW(245):     Case "O4": Ma = ChrW(213)
        Case "o5": Ma = ChrW(7885):    Case "O5": Ma = ChrW(7884)
        Case "o6": Ma = ChrW(244):     Case "O6": Ma = ChrW(212)
        Case "o7": Ma = ChrW(417):     Case "O7": Ma = ChrW(416)
        Case "u1": Ma = ChrW(250):     Case "U1": Ma = ChrW(218)
        Case "u2": Ma = ChrW(249):     Case "U2": Ma = ChrW(217)
        Case "u3": Ma = ChrW(7911):    Case "U3": Ma = ChrW(7910)
        Case "u4": Ma = ChrW(361):     Case "U4": Ma = ChrW(360)
        Case "u5": Ma = ChrW(7909):    Case "U5": Ma = ChrW(7908)
        Case "u7": Ma = ChrW(432):     Case "U7": Ma = ChrW(431)
        Case "y1": Ma = ChrW(253):     Case "Y1": Ma = ChrW(221)
        Case "y2": Ma = ChrW(7923):    Case "Y2": Ma = ChrW(7922)
        Case "y3": Ma = ChrW(7927):    Case "Y3": Ma = ChrW(7926)
        Case "y4": Ma = ChrW(7929):    Case "Y4": Ma = ChrW(7928)
        Case "y5": Ma = ChrW(7925):    Case "Y5": Ma = ChrW(7924)
    End Select
    If Ma <> MaLuu Then
        UniVBA = UniVBA & Ma
        a = i + 2
    Else
        UniVBA = UniVBA & Mid(Str, i, 1)
        a = i + 1
    End If
End If
Next i
End Function
 
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
2. Hàm MsgUni

Hàm MsgUni được sự hỗ trợ của Hàm API MessageBox và UniVBA
PHP: 
Public Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxW" (ByVal hwnd As Long, _
                                                                          ByVal lpText As Long, _
                                                                          ByVal lpCaption As Long, _
                                                                          ByVal wType As Long) As Long


Public Function MsgUni(ByVal Chuoi As String, Optional Bieutuong As VbMsgBoxStyle = 64, _
                        Optional ByVal Tieude As String = "Tho6ng ba1o !", _
                        Optional ByVal Khac As Long = 0) As VbMsgBoxResult

MsgUni = MessageBox(Khac, StrPtr(UniVBA(Chuoi)), StrPtr(UniVBA(Tieude)), Bieutuong)
End Function

Với các hàm trên ta có thể nhập chữ tiếng việt trên VBA khi xuất dữ liệu ra Worksheet, Captain của application, Msgbox, PopManu..

Tuy nhiên hàm trên vẫn chưa áp dụng được cho Captain trên userform
 

File đính kèm

  • Function UniVBA-MsgUni.xls
    94 KB · Đọc: 1,171
Lần chỉnh sửa cuối:
Upvote 0
Và đây là một hàm chuyển đổi Uni sưu tầm trên Caulacbovb.com :
PHP: 
Public Function Uni(sText As String)
Dim i As Integer, J As Integer
Dim sCurChar As String, sPreChar As String, sPreTxt As String
For J = 1 To 2
For i = 2 To Len(sText)
sCurChar = Mid(sText, i, 1)
sPreTxt = Left(sText, i - 2)
sPreChar = Mid(sText, i - 1, 1)
Select Case sCurChar
Case "1"
Select Case sPreChar
'a
Case "a": sText = sPreTxt & ChrW$(&HE1) & Right(sText, Len(sText) - i)
Case "A": sText = sPreTxt & ChrW$(&HC1) & Right(sText, Len(sText) - i)
Case ChrW$(&HE2): sText = sPreTxt & ChrW$(&H1EA5) & Right(sText, Len(sText) - i)
Case ChrW$(&HC2): sText = sPreTxt & ChrW$(&H1EA4) & Right(sText, Len(sText) - i)
Case ChrW$(&H103): sText = sPreTxt & ChrW$(&H1EAF) & Right(sText, Len(sText) - i)
Case ChrW$(&H102): sText = sPreTxt & ChrW$(&H1EAE) & Right(sText, Len(sText) - i)

'e
Case "e": sText = sPreTxt & ChrW$(&HE9) & Right(sText, Len(sText) - i)
Case "E": sText = sPreTxt & ChrW$(&HC9) & Right(sText, Len(sText) - i)
Case ChrW$(&HEA): sText = sPreTxt & ChrW$(&H1EBF) & Right(sText, Len(sText) - i)
Case ChrW$(&HCA): sText = sPreTxt & ChrW$(&H1EBE) & Right(sText, Len(sText) - i)

'i
Case "i": sText = sPreTxt & ChrW$(&HED) & Right(sText, Len(sText) - i)
Case "I": sText = sPreTxt & ChrW$(&HCD) & Right(sText, Len(sText) - i)

'o
Case "o": sText = sPreTxt & ChrW$(&HF3) & Right(sText, Len(sText) - i)
Case "O": sText = sPreTxt & ChrW$(&HD3) & Right(sText, Len(sText) - i)
Case ChrW$(&HF4): sText = sPreTxt & ChrW$(&H1ED1) & Right(sText, Len(sText) - i)
Case ChrW$(&HD4): sText = sPreTxt & ChrW$(&H1ED0) & Right(sText, Len(sText) - i)
Case ChrW$(&H1A1): sText = sPreTxt & ChrW$(&H1EDB) & Right(sText, Len(sText) - i)
Case ChrW$(&H1A0): sText = sPreTxt & ChrW$(&H1EDA) & Right(sText, Len(sText) - i)

'u
Case "u": sText = sPreTxt & ChrW$(&HFA) & Right(sText, Len(sText) - i)
Case "U": sText = sPreTxt & ChrW$(&HDA) & Right(sText, Len(sText) - i)
Case ChrW$(&H1B0): sText = sPreTxt & ChrW$(&H1EE9) & Right(sText, Len(sText) - i)
Case ChrW$(&H1AF): sText = sPreTxt & ChrW$(&H1EE8) & Right(sText, Len(sText) - i)

'y
Case "y": sText = sPreTxt & ChrW$(&HFD) & Right(sText, Len(sText) - i)
Case "Y": sText = sPreTxt & ChrW$(&HDD) & Right(sText, Len(sText) - i)

End Select

Case "2"
Select Case sPreChar
'a
Case "a": sText = sPreTxt & ChrW$(&HE0) & Right(sText, Len(sText) - i)
Case "A": sText = sPreTxt & ChrW$(&HC0) & Right(sText, Len(sText) - i)
Case ChrW$(&HE2): sText = sPreTxt & ChrW$(&H1EA7) & Right(sText, Len(sText) - i)
Case ChrW$(&HC2): sText = sPreTxt & ChrW$(&H1EA6) & Right(sText, Len(sText) - i)
Case ChrW$(&H103): sText = sPreTxt & ChrW$(&H1EB1) & Right(sText, Len(sText) - i)
Case ChrW$(&H102): sText = sPreTxt & ChrW$(&H1EB0) & Right(sText, Len(sText) - i)

'e
Case "e": sText = sPreTxt & ChrW$(&HE8) & Right(sText, Len(sText) - i)
Case "E": sText = sPreTxt & ChrW$(&HC8) & Right(sText, Len(sText) - i)
Case ChrW$(&HEA): sText = sPreTxt & ChrW$(&H1EC1) & Right(sText, Len(sText) - i)
Case ChrW$(&HCA): sText = sPreTxt & ChrW$(&H1EC0) & Right(sText, Len(sText) - i)

'i
Case "i": sText = sPreTxt & ChrW$(&HEC) & Right(sText, Len(sText) - i)
Case "I": sText = sPreTxt & ChrW$(&HCC) & Right(sText, Len(sText) - i)

'o
Case "o": sText = sPreTxt & ChrW$(&HF2) & Right(sText, Len(sText) - i)
Case "O": sText = sPreTxt & ChrW$(&HD2) & Right(sText, Len(sText) - i)
Case ChrW$(&HF4): sText = sPreTxt & ChrW$(&H1ED3) & Right(sText, Len(sText) - i)
Case ChrW$(&HD4): sText = sPreTxt & ChrW$(&H1ED2) & Right(sText, Len(sText) - i)
Case ChrW$(&H1A1): sText = sPreTxt & ChrW$(&H1EDD) & Right(sText, Len(sText) - i)
Case ChrW$(&H1A0): sText = sPreTxt & ChrW$(&H1EDC) & Right(sText, Len(sText) - i)

'u
Case "u": sText = sPreTxt & ChrW$(&HF9) & Right(sText, Len(sText) - i)
Case "U": sText = sPreTxt & ChrW$(&HD9) & Right(sText, Len(sText) - i)
Case ChrW$(&H1B0): sText = sPreTxt & ChrW$(&H1EEB) & Right(sText, Len(sText) - i)
Case ChrW$(&H1AF): sText = sPreTxt & ChrW$(&H1EEA) & Right(sText, Len(sText) - i)

'y
Case "y": sText = sPreTxt & ChrW$(&H1EF3) & Right(sText, Len(sText) - i)
Case "Y": sText = sPreTxt & ChrW$(&H1EF2) & Right(sText, Len(sText) - i)

End Select

Case "3"
Select Case sPreChar
'a
Case "a": sText = sPreTxt & ChrW$(&H1EA3) & Right(sText, Len(sText) - i)
Case "A": sText = sPreTxt & ChrW$(&H1EA2) & Right(sText, Len(sText) - i)
Case ChrW$(&HE2): sText = sPreTxt & ChrW$(&H1EA9) & Right(sText, Len(sText) - i)
Case ChrW$(&HC2): sText = sPreTxt & ChrW$(&H1EA8) & Right(sText, Len(sText) - i)
Case ChrW$(&H103): sText = sPreTxt & ChrW$(&H1EB3) & Right(sText, Len(sText) - i)
Case ChrW$(&H102): sText = sPreTxt & ChrW$(&H1EB2) & Right(sText, Len(sText) - i)

'e
Case "e": sText = sPreTxt & ChrW$(&H1EBB) & Right(sText, Len(sText) - i)
Case "E": sText = sPreTxt & ChrW$(&H1EBA) & Right(sText, Len(sText) - i)
Case ChrW$(&HEA): sText = sPreTxt & ChrW$(&H1EC3) & Right(sText, Len(sText) - i)
Case ChrW$(&HCA): sText = sPreTxt & ChrW$(&H1EC2) & Right(sText, Len(sText) - i)

'i
Case "i": sText = sPreTxt & ChrW$(&H1EC9) & Right(sText, Len(sText) - i)
Case "I": sText = sPreTxt & ChrW$(&H1EC8) & Right(sText, Len(sText) - i)

'o
Case "o": sText = sPreTxt & ChrW$(&H1ECF) & Right(sText, Len(sText) - i)
Case "O": sText = sPreTxt & ChrW$(&H1ECE) & Right(sText, Len(sText) - i)
Case ChrW$(&HF4): sText = sPreTxt & ChrW$(&H1ED5) & Right(sText, Len(sText) - i)
Case ChrW$(&HD4): sText = sPreTxt & ChrW$(&H1ED4) & Right(sText, Len(sText) - i)
Case ChrW$(&H1A1): sText = sPreTxt & ChrW$(&H1EDF) & Right(sText, Len(sText) - i)
Case ChrW$(&H1A0): sText = sPreTxt & ChrW$(&H1EDE) & Right(sText, Len(sText) - i)

'u
Case "u": sText = sPreTxt & ChrW$(&H1EE7) & Right(sText, Len(sText) - i)
Case "U": sText = sPreTxt & ChrW$(&H1EE6) & Right(sText, Len(sText) - i)
Case ChrW$(&H1B0): sText = sPreTxt & ChrW$(&H1EED) & Right(sText, Len(sText) - i)
Case ChrW$(&H1AF): sText = sPreTxt & ChrW$(&H1EEC) & Right(sText, Len(sText) - i)

'y
Case "y": sText = sPreTxt & ChrW$(&H1EF7) & Right(sText, Len(sText) - i)
Case "Y": sText = sPreTxt & ChrW$(&H1EF6) & Right(sText, Len(sText) - i)

End Select

Case "4"
Select Case sPreChar
'a
Case "a": sText = sPreTxt & ChrW$(&HE3) & Right(sText, Len(sText) - i)
Case "A": sText = sPreTxt & ChrW$(&HC3) & Right(sText, Len(sText) - i)
Case ChrW$(&HE2): sText = sPreTxt & ChrW$(&H1EAB) & Right(sText, Len(sText) - i)
Case ChrW$(&HC2): sText = sPreTxt & ChrW$(&H1EAA) & Right(sText, Len(sText) - i)
Case ChrW$(&H103): sText = sPreTxt & ChrW$(&H1EB5) & Right(sText, Len(sText) - i)
Case ChrW$(&H102): sText = sPreTxt & ChrW$(&H1EB4) & Right(sText, Len(sText) - i)

'e
Case "e": sText = sPreTxt & ChrW$(&H1EBD) & Right(sText, Len(sText) - i)
Case "E": sText = sPreTxt & ChrW$(&H1EBC) & Right(sText, Len(sText) - i)
Case ChrW$(&HEA): sText = sPreTxt & ChrW$(&H1EC5) & Right(sText, Len(sText) - i)
Case ChrW$(&HCA): sText = sPreTxt & ChrW$(&H1EC4) & Right(sText, Len(sText) - i)

'i
Case "i": sText = sPreTxt & ChrW$(&H129) & Right(sText, Len(sText) - i)
Case "I": sText = sPreTxt & ChrW$(&H128) & Right(sText, Len(sText) - i)

'o
Case "o": sText = sPreTxt & ChrW$(&HF5) & Right(sText, Len(sText) - i)
Case "O": sText = sPreTxt & ChrW$(&HD5) & Right(sText, Len(sText) - i)
Case ChrW$(&HF4): sText = sPreTxt & ChrW$(&H1ED7) & Right(sText, Len(sText) - i)
Case ChrW$(&HD4): sText = sPreTxt & ChrW$(&H1ED6) & Right(sText, Len(sText) - i)
Case ChrW$(&H1A1): sText = sPreTxt & ChrW$(&H1EE1) & Right(sText, Len(sText) - i)
Case ChrW$(&H1A0): sText = sPreTxt & ChrW$(&H1EE0) & Right(sText, Len(sText) - i)

'u
Case "u": sText = sPreTxt & ChrW$(&H169) & Right(sText, Len(sText) - i)
Case "U": sText = sPreTxt & ChrW$(&H168) & Right(sText, Len(sText) - i)
Case ChrW$(&H1B0): sText = sPreTxt & ChrW$(&H1EEF) & Right(sText, Len(sText) - i)
Case ChrW$(&H1AF): sText = sPreTxt & ChrW$(&H1EEE) & Right(sText, Len(sText) - i)

'y
Case "y": sText = sPreTxt & ChrW$(&H1EF9) & Right(sText, Len(sText) - i)
Case "Y": sText = sPreTxt & ChrW$(&H1EF8) & Right(sText, Len(sText) - i)
End Select
Code còn tiếp
 
Upvote 0
code tiếp theo :
PHP: 
Case "5"
Select Case sPreChar
'a
Case "a": sText = sPreTxt & ChrW$(&H1EA1) & Right(sText, Len(sText) - i)
Case "A": sText = sPreTxt & ChrW$(&H1EA0) & Right(sText, Len(sText) - i)
Case ChrW$(&HE2): sText = sPreTxt & ChrW$(&H1EAD) & Right(sText, Len(sText) - i)
Case ChrW$(&HC2): sText = sPreTxt & ChrW$(&H1EAC) & Right(sText, Len(sText) - i)
Case ChrW$(&H103): sText = sPreTxt & ChrW$(&H1EB7) & Right(sText, Len(sText) - i)
Case ChrW$(&H102): sText = sPreTxt & ChrW$(&H1EB6) & Right(sText, Len(sText) - i)

'e
Case "e": sText = sPreTxt & ChrW$(&H1EB9) & Right(sText, Len(sText) - i)
Case "E": sText = sPreTxt & ChrW$(&H1EB8) & Right(sText, Len(sText) - i)
Case ChrW$(&HEA): sText = sPreTxt & ChrW$(&H1EC7) & Right(sText, Len(sText) - i)
Case ChrW$(&HCA): sText = sPreTxt & ChrW$(&H1EC6) & Right(sText, Len(sText) - i)

'i
Case "i": sText = sPreTxt & ChrW$(&H1ECB) & Right(sText, Len(sText) - i)
Case "I": sText = sPreTxt & ChrW$(&H1ECA) & Right(sText, Len(sText) - i)

'o
Case "o": sText = sPreTxt & ChrW$(&H1ECD) & Right(sText, Len(sText) - i)
Case "O": sText = sPreTxt & ChrW$(&H1ECC) & Right(sText, Len(sText) - i)
Case ChrW$(&HF4): sText = sPreTxt & ChrW$(&H1ED9) & Right(sText, Len(sText) - i)
Case ChrW$(&HD4): sText = sPreTxt & ChrW$(&H1ED8) & Right(sText, Len(sText) - i)
Case ChrW$(&H1A1): sText = sPreTxt & ChrW$(&H1EE3) & Right(sText, Len(sText) - i)
Case ChrW$(&H1A0): sText = sPreTxt & ChrW$(&H1EE2) & Right(sText, Len(sText) - i)

'u
Case "u": sText = sPreTxt & ChrW$(&H1EE5) & Right(sText, Len(sText) - i)
Case "U": sText = sPreTxt & ChrW$(&H1EE4) & Right(sText, Len(sText) - i)
Case ChrW$(&H1B0): sText = sPreTxt & ChrW$(&H1EF1) & Right(sText, Len(sText) - i)
Case ChrW$(&H1AF): sText = sPreTxt & ChrW$(&H1EF0) & Right(sText, Len(sText) - i)

'y
Case "y": sText = sPreTxt & ChrW$(&H1EF5) & Right(sText, Len(sText) - i)
Case "Y": sText = sPreTxt & ChrW$(&H1EF4) & Right(sText, Len(sText) - i)
End Select

Case "6"
Select Case sPreChar
'a
Case "a": sText = sPreTxt & ChrW$(&HE2) & Right(sText, Len(sText) - i)
Case "A": sText = sPreTxt & ChrW$(&HC2) & Right(sText, Len(sText) - i)

'e
Case "e": sText = sPreTxt & ChrW$(&HEA) & Right(sText, Len(sText) - i)
Case "E": sText = sPreTxt & ChrW$(&HCA) & Right(sText, Len(sText) - i)

'o
Case "o": sText = sPreTxt & ChrW$(&HF4) & Right(sText, Len(sText) - i)
Case "O": sText = sPreTxt & ChrW$(&HD4) & Right(sText, Len(sText) - i)
End Select

Case "7"
Select Case sPreChar
'o
Case "o": sText = sPreTxt & ChrW$(&H1A1) & Right(sText, Len(sText) - i)
Case "O": sText = sPreTxt & ChrW$(&H1A0) & Right(sText, Len(sText) - i)

'u
Case "u": sText = sPreTxt & ChrW$(&H1B0) & Right(sText, Len(sText) - i)
Case "U": sText = sPreTxt & ChrW$(&H1AF) & Right(sText, Len(sText) - i)
End Select

Case "8"
Select Case sPreChar
'a
Case "a": sText = sPreTxt & ChrW$(&H103) & Right(sText, Len(sText) - i)
Case "A": sText = sPreTxt & ChrW$(&H102) & Right(sText, Len(sText) - i)
End Select

Case "9"
Select Case sPreChar
'd
Case "d": sText = sPreTxt & ChrW$(&H111) & Right(sText, Len(sText) - i)
Case "D": sText = sPreTxt & ChrW$(&H110) & Right(sText, Len(sText) - i)
End Select

End Select
Next i
Next J
Uni = sText
End Function
 
Upvote 0
Danh ơi, nếu bỏ dấu theo kiểu VNI thì được còn bỏ dấu theo kiểu Telex thì thua. Mà phải thế này cơ: Chữ "Nguyễn" phải gõ thế này mới ra: "Nguye64n"
 
Upvote 0
cái này chỉ cho phép kiểu gõ Vni thôi còn telex thì sao nhỉ!
 
Upvote 0
Và Đây là Hàm dùng cho Telex :

UniVBAT :

PHP: 
Public Function UniVBAT(Str As String) As String
Dim Ma As String, MaLuu As String, i As Long, a As Long
a = 1
For i = a To Len(Str)
i = a
Ma = Mid(Str, i, 3)
MaLuu = Ma
Select Case Ma
    Case "aws": Ma = ChrW(7855):     Case "Aws": Ma = ChrW(7854)
    Case "awf": Ma = ChrW(7857):     Case "Awf": Ma = ChrW(7856)
    Case "awr": Ma = ChrW(7859):     Case "Awr": Ma = ChrW(7858)
    Case "awx": Ma = ChrW(7861):     Case "Awx": Ma = ChrW(7860)
    Case "awj": Ma = ChrW(7863):     Case "Awj": Ma = ChrW(7862)
    Case "aas": Ma = ChrW(7845):     Case "Aas": Ma = ChrW(7844)
    Case "aaf": Ma = ChrW(7847):     Case "Aaf": Ma = ChrW(7846)
    Case "aar": Ma = ChrW(7849):     Case "Aar": Ma = ChrW(7848)
    Case "aax": Ma = ChrW(7851):     Case "Aax": Ma = ChrW(7850)
    Case "aaj": Ma = ChrW(7853):     Case "Aaj": Ma = ChrW(7852)
    Case "ees": Ma = ChrW(7871):     Case "Ees": Ma = ChrW(7870)
    Case "eef": Ma = ChrW(7873):     Case "Eef": Ma = ChrW(7872)
    Case "eer": Ma = ChrW(7875):     Case "Eer": Ma = ChrW(7874)
    Case "eex": Ma = ChrW(7877):     Case "Eex": Ma = ChrW(7876)
    Case "eej": Ma = ChrW(7879):     Case "Eej": Ma = ChrW(7878)
    Case "oos": Ma = ChrW(7889):     Case "Oos": Ma = ChrW(7888)
    Case "oof": Ma = ChrW(7891):     Case "Oof": Ma = ChrW(7890)
    Case "oor": Ma = ChrW(7893):     Case "Oor": Ma = ChrW(7892)
    Case "oox": Ma = ChrW(7895):     Case "Oox": Ma = ChrW(7894)
    Case "ooj": Ma = ChrW(7897):     Case "Ooj": Ma = ChrW(7896)
    Case "ows": Ma = ChrW(7899):     Case "Ows": Ma = ChrW(7898)
    Case "owf": Ma = ChrW(7901):     Case "Owf": Ma = ChrW(7900)
    Case "owr": Ma = ChrW(7903):     Case "Owr": Ma = ChrW(7902)
    Case "owx": Ma = ChrW(7905):     Case "Owx": Ma = ChrW(7904)
    Case "owj": Ma = ChrW(7907):     Case "Owj": Ma = ChrW(7906)
    Case "uws": Ma = ChrW(7913):     Case "Uws": Ma = ChrW(7912)
    Case "uwf": Ma = ChrW(7915):     Case "Uwf": Ma = ChrW(7914)
    Case "uwr": Ma = ChrW(7917):     Case "Uwr": Ma = ChrW(7916)
    Case "uwx": Ma = ChrW(7919):     Case "Uwx": Ma = ChrW(7918)
    Case "uwj": Ma = ChrW(7921):     Case "Uwj": Ma = ChrW(7920)
End Select
If Ma <> MaLuu Then
    UniVBAT = UniVBAT & Ma
    a = i + 3
Else
    Ma = Mid(Str, i, 2)
    MaLuu = Ma
    Select Case Ma
        Case "as": Ma = ChrW(225):     Case "As": Ma = ChrW(193)
        Case "af": Ma = ChrW(224):     Case "Af": Ma = ChrW(192)
        Case "ar": Ma = ChrW(7843):     Case "Ar": Ma = ChrW(7842)
        Case "ax": Ma = ChrW(227):     Case "Ax": Ma = ChrW(195)
        Case "aj": Ma = ChrW(7841):     Case "Aj": Ma = ChrW(7840)
        Case "aw": Ma = ChrW(259):     Case "Aw": Ma = ChrW(258)
        Case "aa": Ma = ChrW(226):     Case "Aa": Ma = ChrW(194)
        Case "dd": Ma = ChrW(273):     Case "Dd": Ma = ChrW(272)
        Case "es": Ma = ChrW(233):     Case "Es": Ma = ChrW(201)
        Case "ef": Ma = ChrW(232):     Case "Ef": Ma = ChrW(200)
        Case "er": Ma = ChrW(7867):     Case "Er": Ma = ChrW(7866)
        Case "ex": Ma = ChrW(7869):     Case "Ex": Ma = ChrW(7868)
        Case "ej": Ma = ChrW(7865):     Case "Ej": Ma = ChrW(7864)
        Case "ee": Ma = ChrW(234):     Case "Ee": Ma = ChrW(202)
        Case "is": Ma = ChrW(237):     Case "Is": Ma = ChrW(205)
        Case "if": Ma = ChrW(236):     Case "If": Ma = ChrW(204)
        Case "ir": Ma = ChrW(7881):     Case "Ir": Ma = ChrW(7880)
        Case "ix": Ma = ChrW(297):     Case "Ix": Ma = ChrW(296)
        Case "ij": Ma = ChrW(7883):     Case "Ij": Ma = ChrW(7882)
        Case "os": Ma = ChrW(243):     Case "Os": Ma = ChrW(211)
        Case "of": Ma = ChrW(242):     Case "Of": Ma = ChrW(210)
        Case "or": Ma = ChrW(7887):     Case "Or": Ma = ChrW(7886)
        Case "ox": Ma = ChrW(245):     Case "Ox": Ma = ChrW(213)
        Case "oj": Ma = ChrW(7885):     Case "Oj": Ma = ChrW(7884)
        Case "oo": Ma = ChrW(244):     Case "Oo": Ma = ChrW(212)
        Case "ow": Ma = ChrW(417):     Case "Ow": Ma = ChrW(416)
        Case "us": Ma = ChrW(250):     Case "Us": Ma = ChrW(218)
        Case "uf": Ma = ChrW(249):     Case "Uf": Ma = ChrW(217)
        Case "ur": Ma = ChrW(7911):     Case "Ur": Ma = ChrW(7910)
        Case "ux": Ma = ChrW(361):     Case "Ux": Ma = ChrW(360)
        Case "uj": Ma = ChrW(7909):     Case "Uj": Ma = ChrW(7908)
        Case "uw": Ma = ChrW(432):     Case "Uw": Ma = ChrW(431)
        Case "ys": Ma = ChrW(253):     Case "Ys": Ma = ChrW(221)
        Case "yf": Ma = ChrW(7923):     Case "Yf": Ma = ChrW(7922)
        Case "yr": Ma = ChrW(7927):     Case "Yr": Ma = ChrW(7926)
        Case "yx": Ma = ChrW(7929):     Case "Yx": Ma = ChrW(7928)
        Case "yj": Ma = ChrW(7925):     Case "Yj": Ma = ChrW(7924)
    End Select
    If Ma <> MaLuu Then
        UniVBAT = UniVBAT & Ma
        a = i + 2
    Else
        UniVBAT = UniVBAT & Mid(Str, i, 1)
        a = i + 1
    End If
End If
Next i
End Function
 
Upvote 0
MsgUniT :

PHP: 
Public Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxW" (ByVal hwnd As Long, _
                                                                          ByVal lpText As Long, _
                                                                          ByVal lpCaption As Long, _
                                                                          ByVal wType As Long) As Long


Public Function MsgUniT(ByVal Chuoi As String, Optional Bieutuong As VbMsgBoxStyle = 64, _
                        Optional ByVal Tieude As String = "Thoong baso !", _
                        Optional ByVal Khac As Long = 0) As VbMsgBoxResult

MsgUniT = MessageBox(Khac, StrPtr(UniVBAT(Chuoi)), StrPtr(UniVBAT(Tieude)), Bieutuong)
End Function
 
Upvote 0
Vậy có bác nào biết cách chuyển text tiếng Việt lên trên Caption của Form không ạ!
Chì cho cháu với!
Thanks.
 
Upvote 0
tuyetbay đã viết:
Vậy có bác nào biết cách chuyển text tiếng Việt lên trên Caption của Form không ạ!
Chì cho cháu với!
Thanks.
Nhấp chuột vào đây để mở rộng...

Trừ font Unicode ra thì anh làm được.! Hình như Caption của Active Title Bar không hỗ trợ Unicode với dấu tiếng Việt!
 
Upvote 0
Bác nhấn nút Chạy rồi tắt Application Excel đi. Sau đó mở lại sẽ có được Tiếng Việt trên Applcation.
Nếu muốn phục hồi lại thì nhấn nút Reset. Rồi tắt file đi là OK.
Có cách nào thay cho việc tắt file/ mở file lại này không?
Em không tìm được cách làm này.
Nguồn:
http://www.experts-exchange.com/Sof...Office_Suites/MS_Office/Excel/Q_21589851.html
http://www9.ttvnol.com/forum/f_147/193561/trang-2.ttvn?v=boqqm6u9rjldf5l3sgjs
http://www.echip.com.vn/echiproot/html/2003/so24/holo_traloi.html (Dùng từ link này)
1232804054.jpg

Thân.
 

File đính kèm

  • thu.xls
    42 KB · Đọc: 155
Lần chỉnh sửa cuối:
Upvote 0
PHP: 
Public Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxW" (ByVal hwnd As Long, _
                                                                          ByVal lpText As Long, _
                                                                          ByVal lpCaption As Long, _
                                                                          ByVal wType As Long) As Long

Public Function MsgUni(ByVal Chuoi As String, Optional Bieutuong As VbMsgBoxStyle = 64, _
                        Optional ByVal Tieude As String = "Tho6ng ba1o !", _
                        Optional ByVal Khac As Long = 0) As VbMsgBoxResult
MsgUni = MessageBox(Khac, StrPtr(UniVBA(Chuoi)), StrPtr(UniVBA(Tieude)), Bieutuong)
End Function
Sao bác không dùng code này! Thử xem!
Thân.
 
Upvote 0
Po_Pikachu đã viết:
PHP: 
Public Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxW" (ByVal hwnd As Long, _
                                                                          ByVal lpText As Long, _
                                                                          ByVal lpCaption As Long, _
                                                                          ByVal wType As Long) As Long

Public Function MsgUni(ByVal Chuoi As String, Optional Bieutuong As VbMsgBoxStyle = 64, _
                        Optional ByVal Tieude As String = "Tho6ng ba1o !", _
                        Optional ByVal Khac As Long = 0) As VbMsgBoxResult
MsgUni = MessageBox(Khac, StrPtr(UniVBA(Chuoi)), StrPtr(UniVBA(Tieude)), Bieutuong)
End Function
Sao bác không dùng code này! Thử xem!
Thân.
Nhấp chuột vào đây để mở rộng...
nó không hiện tên đấy đủ Ngân ơi! chép đè cái code của bạn cũng không thấy tiếng việt lạ thật.
 
Upvote 0
Po_Pikachu đã viết:
Bác nhấn nút Chạy rồi tắt Application Excel đi. Sau đó mở lại sẽ có được Tiếng Việt trên Applcation.
Nếu muốn phục hồi lại thì nhấn nút Reset. Rồi tắt file đi là OK.
Có cách nào thay cho việc tắt file/ mở file lại này không?
Em không tìm được cách làm này.
Nguồn:
http://www.experts-exchange.com/Sof...Office_Suites/MS_Office/Excel/Q_21589851.html
http://www9.ttvnol.com/forum/f_147/193561/trang-2.ttvn?v=boqqm6u9rjldf5l3sgjs
http://www.echip.com.vn/echiproot/html/2003/so24/holo_traloi.html (Dùng từ link này)
1232804054.jpg

Thân.
Nhấp chuột vào đây để mở rộng...

Cái này mình đâu có thấy nó đổi gì đâu bạn. Thanh tiêu đề nó ra thế này "Nguy?n H?u Th?c"
 
Upvote 0
ongtrungducmx25 đã viết:
Sub msg()
MsgBox "Nguyeeexn Carnh Hoafng Danh.", 64, "Thoong baso !"
MsgUni ("Nguyeeexn Carnh Hoafng Danh.")
End Sub

sao chữ Nguyễn không hiệu được đầy đủ bạn ơi!
Nhấp chuột vào đây để mở rộng...

Anh xem chữ màu đỏ sẽ hiểu lý do thôi.
Còn một lỗi nữa, đó là khi anh Copy đoạn code của Unicode cho gõ telex sửa lại dùng cho gõ vini thì quên sửa lại đoạn giữa :
End Select
If Ma <> MaLuu Then
UniVBAT = UniVBAT & Ma
a = i + 3
Else
Ma = Mid(Str, i, 2)
MaLuu = Ma
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
Upvote 0
ca_dafi đã viết:
Cái này mình đâu có thấy nó đổi gì đâu bạn. Thanh tiêu đề nó ra thế này "Nguy?n H?u Th?c"
Nhấp chuột vào đây để mở rộng...
Sao vậy ta. Máy em chỉ cần nhất nút "Chay" rồi mở lại file trên là được liền mà!
Em chụp hình cho bác xem đó. Đâu có chỉnh sửa gì đâu. Thật đó đơn giản lắm.
Chỉ là chưa vừa ý với vấn đề cử phải mở lại file thì bực chết được.
Bác nhấn nút chạy rồi vào Properties Desktop xem có giống như trong hình này không? Nếu không giống thì chắc API của máy bác bị thiếu rồi! Nên nó không thay đổi được Font của Windows. (Click chuột vào chỗ con chuột đó)
1232859256.jpg


À, không biết có cần cài .Net Framework 2.0 không nhỉ? Máy em cài rồi không biết máy bác thì sao nhỉ?
Thân.
 
Lần chỉnh sửa cuối:
Upvote 0
Nếu là trên Application thì chỉ cần dùng hàm UniVBA của mình là ok, Po_Pikachu thử đưa nó lên thanh tiêu đề trên User Form thử nha.
PHP: 
Sub workbook_open()
Application.Caption = UniVBA("Nguye64n Ca3nh Hoa2ng Danh")
End Sub
 
Upvote 0
Nhưng em khỏi cần UniVBA của bác luôn. Lấy Text ngay trên bảng tính làm luôn. Khỏi cần UniVBA gì cả?
Vậy không đở tốn 1 đống Code sao? Hiiiii
À, còn cái UserForm thì chẳng hiểu nó bị liên quan đến cài quái gì nữa? Sao nó chẳng chị chạy gì hết? Ngay cả UniVBA của bác cũng chỉ có 1 nữa à!
Chưa tìm được nguyên nhân. Tất cả Font Title được được đặt là Arial. Ngay cả gõ tiếng Việt trên Desktop còn được nữa huống gì! nhưng cái Form vẩn chẳng chịu nhút nhít gì hết! Hay là Microsoft đã quy định như vậy hả bác.
1232863512.jpg
http://upvn.info/upload/I11/1232863512.jpg
Thân.
 

File đính kèm

  • thu.xls
    64.5 KB · Đọc: 125
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

T
Tổng hợp từ bảng dữ liệu
Trả lời
0
Đọc
11
tlthanh
T
Manhhung90
Liệt kê các ngày cộng dồn mong muốn vào 1 ô. Nhờ mọi người giúp mình ạ.
2 3 4
Trả lời
64
Đọc
803
ptm0412
ptm0412
jenny12345
tổng hợp dữ liệu theo tháng
Trả lời
12
Đọc
293
Hoàng Tuấn 868
H
O
  • Question
Tìm số thứ tự của sheet trong workbook có nhiều sheets
Trả lời
13
Đọc
3K
Hoàng Tuấn 868
H
H
  • Question
Xóa toàn bộ các dòng giống nhau ở 1 cột
    • Cười
Trả lời
13
Đọc
130
SA_DQ
SA_DQ
S
Hỏi cách nhập dữ liệu vào 1 ô trả kết quả ở 1 ô khác có công thức
Trả lời
9
Đọc
180
Hoàng Tuấn 868
H
pingping2288
Lỗi cứ lần mở lại file excel là font chữ và định dạng ô lại thay đổi
Trả lời
14
Đọc
150
Hoàng Tuấn 868
H
vova2209
  • Question
Tìm địa chỉ ô với 2đk và chuyển thành links
Trả lời
14
Đọc
257
vova2209
vova2209
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
7 8 9
Trả lời
164
Đọc
8K
chstbcaolanh
C
T
Đánh Số Thứ Tự Loại Bỏ Trùng
Trả lời
1
Đọc
50
bebo021999
B
H
Có thể mở file Excel mới sẽ Zoom mặc định 150% không?
Trả lời
4
Đọc
177
VetMini
V
C
Hàm đánh số thứ tự như không đánh dữ liệu trùng
Trả lời
7
Đọc
8K
Trang Tuyet Ngoc Nhi
T
Hai Lúa Miền Tây
  • Question
Hàm chuyển dữ liệu từ cột sang dòng (Hàm melt + wide_to_long của Python trong Excel)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
488
tranhungdao12a3
T
GPE-Trợ Lý
Đăng ký tham dự hội thảo tại Hà Nội: Power Query - Công cụ quản lý dữ liệu
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
4
Đọc
487
PhanTuHuong
PhanTuHuong
tvcneo
  • Question
Nhờ Anh Chị Em giúp mình cách để tạo macro giống như trong file này
Trả lời
17
Đọc
244
huuthang_bd
huuthang_bd
T
Có phải lỗi Excel?
Trả lời
8
Đọc
9K
dinhthang8709
D
T
Công thức lấy dữ liệu
Trả lời
3
Đọc
134
HUONGHCKT
H
S
  • Question
Nhờ anh chị giúp em hàm ngẫu nhiên với tổng là 1 số
Trả lời
6
Đọc
160
SA_DQ
SA_DQ
L
Tự động nhảy số tham chiếu khi sang sheet mới
Trả lời
5
Đọc
5K
Romantic92
R
TieuLong2708
Danh sách lịch cắt người trực
Trả lời
0
Đọc
46
TieuLong2708
TieuLong2708
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom