Gõ tiếng việt trong VBA

tuhocvba

Administrator
Thành viên BQT
Link download dự án:
_____________________________
Đã 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
 

Euler

Administrator
Thành viên BQT
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
 
V

vothanhthu

Guest
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 bởi điều hành viên:

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:
 
D

Deleted member 208

Guest
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:
 
M

maiban2068

Guest
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
 
M

maiban2068

Guest
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")
 
M

maiban2068

Guest
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 .
 

Euler

Administrator
Thành viên BQT
Mình xin phép được cập nhật file demo, link download:
Trong đó xây dựng hàm :
Mã:
'Author: NhanSu website tuhocvba.net
'Edit: Euler tuhocvba.net
Sub msgboxns(ByVal tieude As String, ByVal noidung As String)
    CreateObject("WScript.Shell").Popup noidung, , tieude
End Sub
Mình đặt tên msgboxns là để các bạn nhớ tới bạn @NhanSu , người đề xuất phương án này.
Bạn cần đăng nhập để thấy hình ảnh
 

NhanSu

SMod
Thành viên BQT
Mình cũng chỉ biết qua Google thôi chứ không nghĩ ra được đâu bạn ơi.
 

TranTrinh

Yêu THVBA
Xin chào các anh chị, không biết mình trả lời ở topic này có gây phiền phức gì không, nếu có thì nhờ các anh chị hướng dẫn để mình đăng đúng chỗ.

Mình thấy cách của bạn @NhanSu rất hay, nhưng mình gặp một vấn đề, là dù mình thiết lập kiểu popup dạng Yes/No nhưng khi bấm No thì code vẫn chạy tiếp, cú pháp của nó cũng khác so với Msgbox nên mình không rõ phải làm như thế nào. Vậy có cách nào mình bấm Yes thì nó thực hiện tiếp các đoạn code ở dưới, bấm No thì nó Exit Sub không ạ? Ví dụ như code sau:
Mã:
Sub test()
  With CreateObject("WScript.Shell")
    .Popup IIf(.Popup("noi dung thong bao", , "Tieu de", 4) = 6, "Ban vua chon Yes", "Ban vua chon No"), , "Noi dung thong bao"
  End With
  Range("A1") = 123
End Sub
Mình muốn khi bấm Yes thì nó thay đổi kết quả ô A1, bấm No thì nó Exit Sub.
Mong các anh chị admin diễn đàn giúp đỡ ạ,
Mình xin cảm ơn và chúc mọi người một ngày tốt lành.
 

Euler

Administrator
Thành viên BQT
Chào bạn @TranTrinh . Về hướng của bạn NhanSu, mình chưa có thời gian tìm hiểu nên chưa trả lời bạn ngay được.
Tuy nhiên, bạn có thể sử dụng code ở cho hiệu quả tương đương với ý đồ của bạn:
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 Test2()
  Dim MsgText As String, tieude As String
  Dim Unicode As Long
  Dim rc As Long

    MsgText = "TuhocVBA"
    tieude = "XinChaoBan"
    '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, vbYesNo + vbInformation, _
                       tieude)
    If rc = 7 Then Exit Sub
    Range("A1") = 123
End Sub
 

TranTrinh

Yêu THVBA
@Euler, mình cảm ơn ạ, do mình bỏ toàn bộ funtion viết tiếng Việt và lấy nội dung ở sheet phụ nên mình muốn tham khảo cách của bạn @NhanSu ạ,
Cảm ơn bạn
 

tuhocvba

Administrator
Thành viên BQT
Bạn @TranTrinh thân mến. Bạn có thể dùng cách sau:
Mã:
Sub Sample2()
    Dim wsh As Object, msg As String
    Set wsh = CreateObject("WScript.Shell")
    msg = "tuhocvba"

    If wsh.Popup(msg, 5, "Tieude", 4) = 6 Then Range("A1") = 123
End Sub
Nguồn:
Thời gian tới, chúng tôi sẽ dịch đầy đủ về chuyên đề này, tạm thời thế đã nhé.
 
@TranTrinh
Hoặc là bạn có thể thay con số bằng các Buttons/Icons
Mình xin phép ứng dụng luôn code từ #17 nhé:

Mã:
Sub Sample2()
    'Khai báo
    Dim wsh As Object, tbao As String
    Const tde As String = "https://tuhocvba.net/"
    Const so As Long = 123
    
    'Gán đối tượng,giá trị
    Set wsh = CreateObject("WScript.Shell")
    tbao = Range("A2").Value & so & " vào ô A1!"
    
    'Lựa chọn phương án
    If wsh.Popup(tbao, , tde, vbYesNo + vbQuestion) = 6 Then
        Range("A1") = so 'Nếu chọn Yes
    Else
        Range("A1") = "Neu chon No!"
    End If
    
End Sub
Với code trên đang ví dụ ô A2 trên bảng tính có đoạn văn bản là: "Bạn muốn nhập "

Tham khảo bảng dò Buttons/Icons theo value:
VBScript ConstantValueDescription
Buttons
vbOKOnly
0​
Displays only an OK button. This is the default.
vbOKCancel
1​
Displays the OK and Cancel buttons.
vbAbortRetryIgnore
2​
Displays the Abort, Retry, and Ignore buttons.
vbYesNoCancel
3​
Displays the Yes, No, and Cancel buttons.
vbYesNo
4
Displays the Yes and No buttons.
vbRetryCancel
5​
Displays the Retry and Cancel buttons.
Icons
vbCritical
16​
Displays the Critical Message icon.
vbQuestion
32
Displays the Warning Query icon.
vbExclamation
48​
Displays the Warning Message icon.
vbInformation
64​
Displays the Information Message icon.
Default Buttons
vbDefaultButton1
0​
The first button is the default (that is, the button selected when the user presses Enter).
vbDefaultButton2
256​
The second button is the default.
vbDefaultButton3
512​
The third button is the default.
 
Sửa lần cuối:

tuhocvba

Administrator
Thành viên BQT
Để hiện cảnh báo lỗi các bạn sửa tham số 4=>1:
Mã:
Cũ:
Application.Assistant.DoAlert "Thong bao", UniConvert("Chuyeejn chawrng cos gif", "Telex"), 0, 4, 0, 0, 0
Mới:
Application.Assistant.DoAlert "Thong bao", UniConvert("Chuyeejn chawrng cos gif", "Telex"), 0, 1, 0, 0, 0
Bạn cần đăng nhập để thấy đính kèm

Như vậy là đủ dùng rồi đấy.
 

tuhocvba

Administrator
Thành viên BQT
@TranTrinh

Mình không biết đăng bài, hình ảnh thế nào (Admin hỗ trợ mh với nhé)
Cho mình thêm một giải pháp:
Mã:
Function MsgboxT(ByVal Content As String, Optional Btn_Icon_Defaut As VbMsgBoxStyle, Optional ByVal title As String, Optional TimeOut As Integer = 32000) As VbMsgBoxResult
            Dim Wshell As Object
            Set Wshell = CreateObject("WScript.Shell")
            MsgboxT = Wshell.Popup(Content, TimeOut, title, Btn_Icon_Defaut)
End Function

Sub test()
    Dim str
    str =Range("A1")
    MsgboxT str, vbYesNo, str
End Sub
Tôi có thấy cách này khác gì với đâu nhỉ.
 
Top