Gõ tiếng việt trong VBA

tuhocvba

Administrator
Thành viên BQT
Đã từ lâu, chúng ta muốn hiện cảnh báo tiếng Việt trong VBA, nhưng thật tiếc là VBA không hỗ trợ điều này.
Sau khi tra cứu internet, thì mình nhận thấy, cách xây dựng hàm riêng để hiển thị tiếng Việt là tối ưu nhất.
Để không dài dòng, mình sẽ đi thẳng vào vấn đề code.
Có hai kiểu gõ thông dụng đó là VNI và Telex, trong đó kiểu gõ Telex là thông dụng hơn cả.
Nguồn:
Mã:
https://blog.hocexcel.online/go-tieng-viet-trong-vba-su-dung-msgbox-co-ho-tro-unicode-trong-vba.html
Cụ thể code như sau:
Mã:
Function UniConvert(text As String, InputMethod As String) As String
Dim VNI_Type, Telex_Type, CharCode, temp, i As Long
UniConvert = text
VNI_Type = Array("a81", "a82", "a83", "a84", "a85", "a61", "a62", "a63", "a64", "a65", "e61", _
"e62", "e63", "e64", "e65", "o61", "o62", "o63", "o64", "o65", "o71", "o72", "o73", "o74", _
"o75", "u71", "u72", "u73", "u74", "u75", "a1", "a2", "a3", "a4", "a5", "a8", "a6", "d9", _
"e1", "e2", "e3", "e4", "e5", "e6", "i1", "i2", "i3", "i4", "i5", "o1", "o2", "o3", "o4", _
"o5", "o6", "o7", "u1", "u2", "u3", "u4", "u5", "u7", "y1", "y2", "y3", "y4", "y5")

Telex_Type = Array("aws", "awf", "awr", "awx", "awj", "aas", "aaf", "aar", "aax", "aaj", "ees", _
"eef", "eer", "eex", "eej", "oos", "oof", "oor", "oox", "ooj", "ows", "owf", "owr", "owx", _
"owj", "uws", "uwf", "uwr", "uwx", "uwj", "as", "af", "ar", "ax", "aj", "aw", "aa", "dd", _
"es", "ef", "er", "ex", "ej", "ee", "is", "if", "ir", "ix", "ij", "os", "of", "or", "ox", _
"oj", "oo", "ow", "us", "uf", "ur", "ux", "uj", "uw", "ys", "yf", "yr", "yx", "yj")
CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
ChrW(7849), ChrW(7851), ChrW(7853), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), ChrW(7899), ChrW(7901), ChrW(7903), _
ChrW(7905), ChrW(7907), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), ChrW(7921), ChrW(225), _
ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), ChrW(259), ChrW(226), ChrW(273), ChrW(233), ChrW(232), _
ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), ChrW(7881), ChrW(297), ChrW(7883), _
ChrW(243), ChrW(242), ChrW(7887), ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(250), ChrW(249), _
ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))


Select Case InputMethod
    Case Is = "VNI": temp = VNI_Type
    Case Is = "Telex": temp = Telex_Type
End Select
For i = 0 To UBound(CharCode)
UniConvert = Replace(UniConvert, temp(i), CharCode(i))
UniConvert = Replace(UniConvert, UCase(temp(i)), UCase(CharCode(i)))
Next i

End Function
Do có hai cách gõ và người dùng có nhiều khả năng sử dụng cả chữ hoa và chữ thường vì vậy hàm trên đáp ứng được yêu cầu cơ bản.
Để sử dụng tiếng việt chúng ta không dùng hàm msgbox thông thường mà dùng hàm DoAlert như sau:
Mã:
Sub test()
    Application.Assistant.DoAlert "Thong bao", UniConvert("Chuyeejn chawrng cos gif", "Telex"), 0, 4, 0, 0, 0
End sub
Kết quả là chúng ta được:
Bạn cần đăng nhập để thấy hình ảnh

Trước hết về các thông số option ở phía sau gồm 5 số:
Mã:
0,4,0,0,0
thì các bạn có thể tự kiểm nghiệm bằng cách tự thay các giá trị khác nhau (khi gõ code sẽ xuất hiện gợi ý), nếu đổi thành
Mã:
1,4,0,0,0
thì cảnh báo sẽ ra hai nút OK và CANCEL.
Nếu thay bằng
Mã:
 0,0,0,0,0
ta có được biểu tượng giống với msgbox thông thường.
Bạn cần đăng nhập để thấy hình ảnh


Tuy nhiên, với code trên ta phải bỏ dấu ngay sau nguyên âm, nếu chúng ta bỏ dấu như sau:
Mã:
 chuyeenj daays thif ai chawngr bieets
ta thu được kết quả không như mong muốn:
Bạn cần đăng nhập để thấy hình ảnh

Vì vậy cần phải xây dựng một hàm riêng để xử lý việc bỏ dấu như cách gõ thông thường, đó là:
Chúng ta thường bỏ dấu trước khi gõ dấu cách để sang một từ khác.
Mã:
Function sapxepdautruocnguyenam(ByVal text As String) As String
's f r x j
'Nguyen am: a e o u i y
    Dim temp    As String
    Dim i       As Integer
    Dim j       As Integer
   
    Dim c       As String
    Dim c2      As String
    Dim out     As String
   
    Dim d1      As String
    Dim d2      As String
    Dim dau     As String
    Dim cuoi    As String
   
   
   
    Const na    As String = "aeouiywAEOUIYW" 'Nguyen am
    Const da   As String = "sfrjxSFRJX"  'Dau
   
    temp = text & " "
    out = ""
    For i = 1 To Len(temp) - 1 Step 1
        c = Mid(temp, i, 1)
        out = out & c
        c2 = Mid(temp, i + 1, 1)
        If InStr(1, na, c) > 0 And InStr(1, na, c2) = 0 Then 'Phat hien nguyen am va dang sau la phu am
            'Tim dau
            For j = i + 1 To Len(temp) - 1
                d1 = Mid(temp, j, 1)
                d2 = Mid(temp, j + 1, 1)
                If d1 = " " Then Exit For
                If InStr(1, da, d1) > 0 And d2 = " " Then
                    out = out & d1
                    dau = Mid(temp, 1, j - 1)
                    cuoi = Mid(temp, j + 1, Len(temp) - j)
                    temp = dau & cuoi
                    Exit For
                End If
            Next j
           
        End If
    Next i
    sapxepdautruocnguyenam = out
End Function
Và bây giờ ta có được kết quả rất tốt như sau:
Mã:
Sub tuhocvba_net()
    Dim l   As String
    l = sapxepdautruocnguyenam("chuyeenj daays thif ai chawngr bieets")
    Application.Assistant.DoAlert "Thong bao", UniConvert(l, "Telex"), 0, 0, 0, 0, 0

End Sub
Kết quả là:
Bạn cần đăng nhập để thấy hình ảnh


Video giới thiệu:
Bạn cần đăng nhập để thấy đa phương tiện
 
Sửa lần cuối:

Euler

Biên Tập Viên
Với Label.caption trên UserForm áp dụng cách này cũng được nhưng thất bại với UserForm1.Caption.
Mã:
Private Sub UserForm_Initialize()
    Dim s As String
    s = sapxepdautruocnguyenam("chuyeenj ddaays thif ai chawngr bieets")
    UserForm1.Caption = UniConvert(s, "Telex")
    Label1.Caption = UniConvert(s, "Telex")
End Sub
Bạn cần đăng nhập để thấy hình ảnh

Và kết quả cũng thành công với nút bấm.
Mã:
Private Sub UserForm_Initialize()
    Dim s As String
    s = sapxepdautruocnguyenam("chuyeenj daays thif ai chawngr bieets")
    
    CommandButton1.Caption = UniConvert(s, "Telex")
End Sub
Tuy nhiên với Label.Caption, hoặc với nút bấm thì còn cách khác.
Bạn cần đăng nhập để thấy hình ảnh

Ghi sẵn tiếng việt trên sheet rồi cho load ra label trên Userform.
Với nút bấm cũng tương tự, hiển thị tiếng việt có dấu tốt.
Mã:
CommandButton1.Caption = ThisWorkbook.Sheets(1).Cells(1, 1).text
Bạn cần đăng nhập để thấy hình ảnh


Tổng kết: Đối với hộp thoại thông báo, có thể dùng Userform để thiết kế hộp thoại thông báo riêng. Như vậy có thể ghi sẵn tiếng việt trên sheet và cho load vào label/nút bấm rồi cho hiển thị trên UserForm.
 

tuhocvba

Administrator
Thành viên BQT
Trở lại với việc gõ tiếng việt. Để gõ cái kiểu:
Mã:
coongj hoaf xax hooij chur nghiax vieetj nam
thật là nhức mắt. Vậy cần một hàm để chuyển đổi ngược từ có dấu thành kiểu không dấu theo kiểu trên để cho vào code VBA.
Tận dụng ngay hàm của chúng ta, thay tên đổi họ một tí:
Mã:
'tuhoc vba sua ten ham
Function Un_UniConvert(text As String, InputMethod As String) As String
Dim VNI_Type, Telex_Type, CharCode, temp, i As Long
Un_UniConvert = text
VNI_Type = Array("a81", "a82", "a83", "a84", "a85", "a61", "a62", "a63", "a64", "a65", "e61", _
"e62", "e63", "e64", "e65", "o61", "o62", "o63", "o64", "o65", "o71", "o72", "o73", "o74", _
"o75", "u71", "u72", "u73", "u74", "u75", "a1", "a2", "a3", "a4", "a5", "a8", "a6", "d9", _
"e1", "e2", "e3", "e4", "e5", "e6", "i1", "i2", "i3", "i4", "i5", "o1", "o2", "o3", "o4", _
"o5", "o6", "o7", "u1", "u2", "u3", "u4", "u5", "u7", "y1", "y2", "y3", "y4", "y5")

Telex_Type = Array("aws", "awf", "awr", "awx", "awj", "aas", "aaf", "aar", "aax", "aaj", "ees", _
"eef", "eer", "eex", "eej", "oos", "oof", "oor", "oox", "ooj", "ows", "owf", "owr", "owx", _
"owj", "uws", "uwf", "uwr", "uwx", "uwj", "as", "af", "ar", "ax", "aj", "aw", "aa", "dd", _
"es", "ef", "er", "ex", "ej", "ee", "is", "if", "ir", "ix", "ij", "os", "of", "or", "ox", _
"oj", "oo", "ow", "us", "uf", "ur", "ux", "uj", "uw", "ys", "yf", "yr", "yx", "yj")
CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
ChrW(7849), ChrW(7851), ChrW(7853), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), ChrW(7899), ChrW(7901), ChrW(7903), _
ChrW(7905), ChrW(7907), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), ChrW(7921), ChrW(225), _
ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), ChrW(259), ChrW(226), ChrW(273), ChrW(233), ChrW(232), _
ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), ChrW(7881), ChrW(297), ChrW(7883), _
ChrW(243), ChrW(242), ChrW(7887), ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(250), ChrW(249), _
ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))


Select Case InputMethod
    Case Is = "VNI": temp = VNI_Type
    Case Is = "Telex": temp = Telex_Type
End Select
For i = 0 To UBound(CharCode)
Un_UniConvert = Replace(Un_UniConvert, CharCode(i), temp(i)) 'tuhocvba sua code: dao thu tu replace
Un_UniConvert = Replace(Un_UniConvert, UCase(CharCode(i)), UCase(temp(i))) 'tuhocvba sua code: dao thu tu replace
Next i

End Function
Bạn cần đăng nhập để thấy đính kèm
 

vothanhthu

Võ Thành Thứ
Tiếp nối chủ đề đang bỏ ngõ tại #2: Làm sao để gõ tiếng việt trên Caption của Userform

Bản thân của Userform không thể gõ Unicode lên Caption được. Để có thể gõ được Unicode như yêu cầu ở #2, ta cần phải chỉnh sửa các hàm API để viết Unicode.

Vì đây là các hàm API phức tạp, được tổng hợp từ nhiều nguồn, được Thứ chỉnh sửa chút ít và Tác giả cũng có chú thích rất nhiều trong Code, nên Thứ cố gắng tối giảng thao tác giúp các bạn có thể dễ dàng tải về sử dụng nhất có thể, Thứ sẽ không đào sâu vào phân tích Code.

Do Code khá dài, Thứ không thể để hết trong bài viết, nên Thứ sẽ gôm hết lại trong File dính kèm. Các bạn có thể tải về dùng luôn.

Trong file sẽ có 4 Module:
modFormControl modWindowCaption: Chứa các hàm API cần thiết cho việc Unicode trên Caption Userform
modUnicode: Chứa hàm UniConvert Trong #1
modRun: Chỉ để show Userform lên, không quan trọng

Sau khi đã có đủ thì bạn chỉ cần cho Code này vào Userform, kết hợp với hàm UniConvert tại #1 là có thể hiển thị Unicode trên Caption của Userform
Mã:
Private Sub UserForm_Initialize()
    UniCaption Me, UniConvert("Vieejt Nam quee huwowng tooi", "Telex")
End Sub
Và đây là kết quả sau khi chạy code

Bạn cần đăng nhập để thấy đính kèm



Nhấn vào để tải về

Theo Thứ tìm hiểu, đây là cách đơn giản nhất để gõ Tiếng Việt lên Caption mà không cần thông qua trung gian như Cell
Nguồn:
Mã:
' Author: Thuongall - www.caulacbovb.com, Chip Pearson - www.cpearson.com
' Edit: Vothanhthu - TuhocVBA.net
 
Sửa lần cuối:

tuhocvba

Administrator
Thành viên BQT
Bài viết #4 là OK rồi đấy.
Bạn cần đăng nhập để thấy hình ảnh

Cảm ơn Thứ và các bạn đã cộng tác phản hồi để ra được sản phẩm cuối cùng.
Sau đây, các bài viết không cần thiết sẽ được ẩn đi để khỏi làm loãng topic.
Dự phòng download cho #4:
 

sieutocviet3

Thành viên mới
Về lý thuyết, nếu mọi đối tượng trên UserForm đều biểu diễn bằng tiếng việt có dấu, từ Label, cho tới Caption của US, thì giao tiếp giữa người dùng và máy tính đều có thể hiển thị tiếng việt được. Từ nội dung thông báo, cho tới inputbox đều có thể thiết kế bằng UserForm.
Trước đây em có thấy topic này:
Nhưng thấy sản phẩm của các tiền bối lỗi ghê quá, máy em chạy không nổi.
Như vậy, tuhocvba.net là diễn đàn hoàn thiện bước cuối cùng dựa trên thành quả của những người đi trước.
Chúc mừng các anh chị.
 

tuhocvba

Administrator
Thành viên BQT
Msgbox thì không nhất thiết phải sử dụng cách đã nêu ở #1.
Mã:
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function MessageBoxW Lib "user32" _
              (ByVal hwnd As LongPtr, ByVal lpText As LongPtr, _
               ByVal lpCaption As LongPtr, ByVal wType As Long) As Long
    Private Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr
#Else
    Private Declare Function MessageBoxW Lib "user32" _
              (ByVal hwnd As Long, ByVal lpText As Long, _
               ByVal lpCaption As Long, ByVal wType As Long) As Long
    Private Declare Function GetFocus Lib "user32" () As Long
#End If


  Public Function MsgBoxUnicode(ByVal Prompt As String, _
                                  Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _
                                  Optional ByVal Title As String = "Microsoft Excel") As Long

    MsgBoxUnicode = MessageBoxW(GetFocus(), StrPtr(Prompt), StrPtr(Title), Buttons)
    ' MsgBoxUnicode = MessageBoxW(0, StrPtr(Prompt), StrPtr(Title), Buttons)
  End Function

  Sub Test1()
  Dim MsgText As String
  Dim Unicode As Long
  Dim rc As Long

    
    MsgText = ChrW(&H3020) & Space(2) & ChrW(&H2668) & Space(2) & ChrW(&H265E)
    MsgText = MsgText & " ABCDE" & vbCrLf & vbCrLf
    '------Phan nay la lay ky tu Unicode. Ban khong can quan tam. Co the su dung ham Unicode co san tren tuhocvba.net de tao noi dung tin nhan---
    For Unicode = &H2660 To &H2667      '
        MsgText = MsgText & ChrW(Unicode) & Space(1)
    Next
    MsgText = MsgText & " 12345" & vbCrLf & vbCrLf

    For Unicode = &H2600 To &H2603      '
        MsgText = MsgText & ChrW(Unicode) & Space(1)
    Next
    '-----Ket thuc lay ky tu Unicode de hien thi-------------------------------------------------------------------------------------------
    MsgText = MsgText & " あいうえお" & vbCrLf & vbCrLf
    'Phan 1 (MsgText) la noi dung msgbox
    'Phan 2 la kieu hop thoai hien thi: vbOKOnly + vbInformation. Hoac: vbYesNoCancel + vbInformation,...
    'Phan 3 la tieu de hop thoai cho msgbox
    rc = MsgBoxUnicode(MsgText, vbOKOnly + vbInformation, _
                       ChrW(&H2661) & " Unicode MsgBox " & ChrW(&H2661))    'end
  End Sub
Bạn cần đăng nhập để thấy đính kèm


Nếu kết hợp với kết quả của #1 sẽ viết code như sau:
Mã:
  Sub Test2()
  Dim MsgText As String, tieude As String
  Dim Unicode As Long
  Dim rc As Long

    
 
    '-----Ket thuc lay ky tu Unicode de hien thi-------------------------------------------------------------------------------------------
    MsgText = sapxepdautruocnguyenam("Tuwj hocj VBA")
    MsgText = UniConvert(MsgText, "Telex")
    tieude = sapxepdautruocnguyenam("Dieenx ddanf tuhocvba chaof cacs banj")
    tieude = UniConvert(tieude, "Telex")
    'Phan 1 (MsgText) la noi dung msgbox
    'Phan 2 la kieu hop thoai hien thi: vbOKOnly + vbInformation. Hoac: vbYesNoCancel + vbInformation,...
    'Phan 3 la tieu de hop thoai cho msgbox
    rc = MsgBoxUnicode(MsgText, vbOKOnly + vbInformation, _
                       tieude)
  End Sub
Kết quả:
Bạn cần đăng nhập để thấy đính kèm


Nguồn tham khảo:
 

maiban2068

Thành viên mới
Vấn đề Inputbox khỏi cần làm gì, tự nhận unicode luôn.
Mã:
  Sub Test3()
  Dim MsgText As String, tieude As String
 
  Dim Name As Variant

    MsgText = sapxepdautruocnguyenam("Tuwj hocj VBA")
    MsgText = UniConvert(MsgText, "Telex")
    tieude = sapxepdautruocnguyenam("Dieenx ddanf tuhocvba chafo cacs banj")
    tieude = UniConvert(tieude, "Telex")
    Name = Application.InputBox(Prompt:=MsgText, Title:=tieude, Default:="Nguyen Van A", Type:=2)  'Type:=2 la kieu ky tu Text
 
  End Sub
Bạn cần đăng nhập để thấy hình ảnh
 

maiban2068

Thành viên mới
Dựa vào các kết quả trong topic này và trong topic:
Tôi đề xuất code sau.
File demo:

Kết quả:
Bạn cần đăng nhập để thấy hình ảnh


Bạn cần đăng nhập để thấy hình ảnh

Bạn cần đăng nhập để thấy hình ảnh


Trong đó, tôi còn tham khảo các tool hỗ trợ của các thành viên trong BQT diễn đàn.
Hiện nay chủ yếu dùng bộ gõ Telex, cho nên sửa lại code để mặc định luôn là Telex.
Mã:
MsgText = UniConvert("Tuwj hocj VBA")
 

maiban2068

Thành viên mới
Diễn giải bài viết :
Code Module tiếng việt (main):
Mã:
Option Explicit
'Developed by Website tuhocvba.net


#If VBA7 And Win64 Then
    Private Declare PtrSafe Function MessageBoxW Lib "user32" _
              (ByVal hwnd As LongPtr, ByVal lpText As LongPtr, _
               ByVal lpCaption As LongPtr, ByVal wType As Long) As Long
    Private Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr
#Else
    Private Declare Function MessageBoxW Lib "user32" _
              (ByVal hwnd As Long, ByVal lpText As Long, _
               ByVal lpCaption As Long, ByVal wType As Long) As Long
    Private Declare Function GetFocus Lib "user32" () As Long
#End If


Public Function MsgBoxUnicode(ByVal Prompt As String, _
                                  Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _
                                  Optional ByVal Title As String = "Microsoft Excel") As Long

    MsgBoxUnicode = MessageBoxW(GetFocus(), StrPtr(Prompt), StrPtr(Title), Buttons)
    ' MsgBoxUnicode = MessageBoxW(0, StrPtr(Prompt), StrPtr(Title), Buttons)
End Function

'https://tuhocvba.net/threads/go-tieng-viet-trong-vba.16/
'INPUT: tieng viet khong dau. Ex: Dieenx ddanf tuwj hocj VBA
'OUTPUT: tieng viet co dau (unicode)
Public Function UniConvert(ByVal text As String) As String
    Dim kq As String
    kq = sapxepdautruocnguyenam(text)
    UniConvert = UniConvertsub(kq)
End Function
'INPUT: tieng viet co dau
'OUTPUT: Dieenx ddanf tuwj hocj VBA
Public Function UnConvertUni(ByVal text As String) As String
    Dim kq As String
    kq = Un_UniConvert(text)
    UnConvertUni = kq
End Function
Private Function sapxepdautruocnguyenam(ByVal text As String) As String
's f r x j
'Nguyen am: a e o u i y
    Dim temp    As String
    Dim i       As Integer
    Dim j       As Integer
  
    Dim c       As String
    Dim c2      As String
    Dim out     As String
  
    Dim d1      As String
    Dim d2      As String
    Dim dau     As String
    Dim cuoi    As String
  
  
  
    Const na    As String = "aeouiywAEOUIYW" 'Nguyen am
    Const da   As String = "sfrjxSFRJX"  'Dau
  
    temp = text & " "
    out = ""
    For i = 1 To Len(temp) - 1 Step 1
        c = Mid(temp, i, 1)
        out = out & c
        c2 = Mid(temp, i + 1, 1)
        If InStr(1, na, c) > 0 And InStr(1, na, c2) = 0 Then 'Phat hien nguyen am va dang sau la phu am
            'Tim dau
            For j = i + 1 To Len(temp) - 1
                d1 = Mid(temp, j, 1)
                d2 = Mid(temp, j + 1, 1)
                If d1 = " " Then Exit For
                If InStr(1, da, d1) > 0 And d2 = " " Then
                    out = out & d1
                    dau = Mid(temp, 1, j - 1)
                    cuoi = Mid(temp, j + 1, Len(temp) - j)
                    temp = dau & cuoi
                    Exit For
                End If
            Next j
          
        End If
    Next i
    sapxepdautruocnguyenam = out
End Function


'https://blog.hocexcel.online/go-tieng-viet-trong-vba-su-dung-msgbox-co-ho-tro-unicode-trong-vba.html
Private Function UniConvertsub(text As String) As String
'Hien nay chi con su dung Telex, cho nen toi sua mac dinh thanh Telex. - website tuhocvba.net
    Dim VNI_Type, Telex_Type, CharCode, temp, i As Long
    Dim InputMethod  As String
    
    UniConvertsub = text
    
    VNI_Type = Array("a81", "a82", "a83", "a84", "a85", "a61", "a62", "a63", "a64", "a65", "e61", _
    "e62", "e63", "e64", "e65", "o61", "o62", "o63", "o64", "o65", "o71", "o72", "o73", "o74", _
    "o75", "u71", "u72", "u73", "u74", "u75", "a1", "a2", "a3", "a4", "a5", "a8", "a6", "d9", _
    "e1", "e2", "e3", "e4", "e5", "e6", "i1", "i2", "i3", "i4", "i5", "o1", "o2", "o3", "o4", _
    "o5", "o6", "o7", "u1", "u2", "u3", "u4", "u5", "u7", "y1", "y2", "y3", "y4", "y5")
    
    Telex_Type = Array("aws", "awf", "awr", "awx", "awj", "aas", "aaf", "aar", "aax", "aaj", "ees", _
    "eef", "eer", "eex", "eej", "oos", "oof", "oor", "oox", "ooj", "ows", "owf", "owr", "owx", _
    "owj", "uws", "uwf", "uwr", "uwx", "uwj", "as", "af", "ar", "ax", "aj", "aw", "aa", "dd", _
    "es", "ef", "er", "ex", "ej", "ee", "is", "if", "ir", "ix", "ij", "os", "of", "or", "ox", _
    "oj", "oo", "ow", "us", "uf", "ur", "ux", "uj", "uw", "ys", "yf", "yr", "yx", "yj")
    CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
    ChrW(7849), ChrW(7851), ChrW(7853), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
    ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), ChrW(7899), ChrW(7901), ChrW(7903), _
    ChrW(7905), ChrW(7907), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), ChrW(7921), ChrW(225), _
    ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), ChrW(259), ChrW(226), ChrW(273), ChrW(233), ChrW(232), _
    ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), ChrW(7881), ChrW(297), ChrW(7883), _
    ChrW(243), ChrW(242), ChrW(7887), ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(250), ChrW(249), _
    ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))

    InputMethod = "Telex"
    Select Case InputMethod
        Case Is = "VNI": temp = VNI_Type
        Case Is = "Telex": temp = Telex_Type
    End Select
    
    For i = 0 To UBound(CharCode)
        UniConvertsub = Replace(UniConvertsub, temp(i), CharCode(i))
        UniConvertsub = Replace(UniConvertsub, UCase(temp(i)), UCase(CharCode(i)))
    Next i

End Function



'Author: Admin tuhocvba Website tuhocvba.net
'Edit: Website tuhocvba.net
Private Function Un_UniConvert(text As String) As String
'Mac dinh kieu go telex
    Dim VNI_Type, Telex_Type, CharCode, temp, i As Long
    Dim InputMethod As String
    Un_UniConvert = text
    VNI_Type = Array("a81", "a82", "a83", "a84", "a85", "a61", "a62", "a63", "a64", "a65", "e61", _
    "e62", "e63", "e64", "e65", "o61", "o62", "o63", "o64", "o65", "o71", "o72", "o73", "o74", _
    "o75", "u71", "u72", "u73", "u74", "u75", "a1", "a2", "a3", "a4", "a5", "a8", "a6", "d9", _
    "e1", "e2", "e3", "e4", "e5", "e6", "i1", "i2", "i3", "i4", "i5", "o1", "o2", "o3", "o4", _
    "o5", "o6", "o7", "u1", "u2", "u3", "u4", "u5", "u7", "y1", "y2", "y3", "y4", "y5")
    
    Telex_Type = Array("aws", "awf", "awr", "awx", "awj", "aas", "aaf", "aar", "aax", "aaj", "ees", _
    "eef", "eer", "eex", "eej", "oos", "oof", "oor", "oox", "ooj", "ows", "owf", "owr", "owx", _
    "owj", "uws", "uwf", "uwr", "uwx", "uwj", "as", "af", "ar", "ax", "aj", "aw", "aa", "dd", _
    "es", "ef", "er", "ex", "ej", "ee", "is", "if", "ir", "ix", "ij", "os", "of", "or", "ox", _
    "oj", "oo", "ow", "us", "uf", "ur", "ux", "uj", "uw", "ys", "yf", "yr", "yx", "yj")
    CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
    ChrW(7849), ChrW(7851), ChrW(7853), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
    ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), ChrW(7899), ChrW(7901), ChrW(7903), _
    ChrW(7905), ChrW(7907), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), ChrW(7921), ChrW(225), _
    ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), ChrW(259), ChrW(226), ChrW(273), ChrW(233), ChrW(232), _
    ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), ChrW(7881), ChrW(297), ChrW(7883), _
    ChrW(243), ChrW(242), ChrW(7887), ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(250), ChrW(249), _
    ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))

    InputMethod = "Telex"
    Select Case InputMethod
        Case Is = "VNI": temp = VNI_Type
        Case Is = "Telex": temp = Telex_Type
    End Select
    For i = 0 To UBound(CharCode)
        Un_UniConvert = Replace(Un_UniConvert, CharCode(i), temp(i)) 'tuhocvba sua code: dao thu tu replace
        Un_UniConvert = Replace(Un_UniConvert, UCase(CharCode(i)), UCase(temp(i))) 'tuhocvba sua code: dao thu tu replace
    Next i

End Function
Code cho UserForm:
Mã:
'Author: Nguyen Duy Tuan - Cong ty CP BLUESOFTS
'Website: http://bluesofts.net
'Bi loi khong chay duoc tren Office 32bit 2016 Win 10, Office 64bit 2013 Win 7
'Edit by maiban2068 website tuhocvba.net
'https://tuhocvba.net/threads/defwindowprocw-va-defwindowproc-khac-nhau-nhu-the-nao.628/#post-3365
Option Explicit
Private Const WM_SETTEXT = &HC
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function DefWindowProcW Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#Else
    Private Declare Function DefWindowProcW Lib "user32" (ByVal HWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As LongPtr) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If
Private Sub UserForm_Initialize()
    Dim hwnd&, sUnicode$
    hwnd = FindWindow("ThunderDFrame", Caption)  ' Tim HWnd cua UserForm
    sUnicode = UniConvert("Dieenx ddanf tuwj hocj VBA chafo cacs banj") 'Noi chua chuoi unicode
    DefWindowProcW hwnd, WM_SETTEXT, 0, StrPtr(sUnicode)
End Sub

Code cho Module test:
Mã:
Option Explicit
'Website tuhocvba.net
'https://tuhocvba.net/threads/gioi-thieu-ham-msgbox.22/
'https://tuhocvba.net/threads/cung-tim-hieu-ve-inputbox.407/
'Msgbox
Sub Test1()
    Dim MsgText As String, tieude As String
    Dim rc As Long
 
    MsgText = UniConvert("Tuwj hocj VBA")
    tieude = UniConvert("Dieenx ddanf tuhocvba chaof cacs banj")
    'Phan 1 (MsgText) la noi dung msgbox
    'Phan 2 la kieu hop thoai hien thi: vbOKOnly + vbInformation. Hoac: vbYesNoCancel + vbInformation,...
    '       Cac ban tham khao them o day:
    '       https://tuhocvba.net/threads/gioi-thieu-ham-msgbox.22/
    'Phan 3 la tieu de hop thoai cho msgbox
    rc = MsgBoxUnicode(MsgText, vbOKOnly + vbInformation, _
                       tieude)
    If rc = 0 Then Exit Sub ' thuc ra dong lenh nay khong can thiet. Khi an OK thi rc = 1.
    'Doan code tiep theo, cac ban viet tuy y
    
End Sub
'InputBox
Sub Test2()
    Dim MsgText As String, tieude As String
 
    Dim Name As Variant


    MsgText = UniConvert("Nhaapj teen vafo ddaay :")
    tieude = UniConvert("Dieenx ddanf tuhocvba chafo cacs banj")
    Name = Application.InputBox(Prompt:=MsgText, Title:=tieude, Default:="Nguyen Van A", Type:=2)  'Type:=2 la kieu ky tu Text
    If VarType(Name) = 11 Then Exit Sub 'Nguoi dung an vao nut Cancel
    'Cac ban tham khao them o day:
    'https://tuhocvba.net/threads/cung-tim-hieu-ve-inputbox.407/
    MsgBox Name
  End Sub
 

tuhocvba

Administrator
Thành viên BQT
Bạn @NhanSu có một cách khác để hiện thông báo tiếng việt có dấu như sau (không sử dụng API):
Mình xin đóng góp một cách hiện MsgBox unicode là dùng phương thức Popup của đối tượng Wshshell như sau, xem thêm về các tham số của Popup tại (không biết post ở đây có phù hợp không vì không phải API):
Mã:
  Sub Test()
    Dim str As String
    str = [A1]
    CreateObject("WScript.Shell").Popup str, , "tuhocvba.net"
  End Sub
Ô A1 chứa chuỗi cần hiện.
Thử nghiệm:

Mã:
  Sub Test()
    Dim str As String
    str = [A1]
    CreateObject("WScript.Shell").Popup str, , str
  End Sub
Bạn cần đăng nhập để thấy đính kèm


Cám ơn @NhanSu .
 
Top