Gõ Tiếng Việt Trong VBA

Menu

• Trang chủ
• Diễn đàn Bài viết mới Tìm chủ đề
• Có gì mới Bài viết mới Hoạt động mới nhất

Đăng nhập Đăng ký Có gì mới? Tìm kiếm

Tìm kiếm

Everywhere Chủ đề This forum This thread Chỉ tìm trong tiêu đề Bởi: Tìm Tìm kiếm nâng cao…

• Bài viết mới
• Tìm chủ đề

Menu Đăng nhập Đăng ký

• Cách upload ảnh lên diễn đàn

• Trang chủ
• Diễn đàn
• Kỹ thuật xử lý Excel
• Lập trình VBA

Gõ tiếng việt trong VBA

• Thread starter tuhocvba
• Ngày gửi 19/5/19

• 1
• 2

Tiếp 1 of 2

Đi đến trang

Tới Tiếp Last

tuhocvba

Administrator

Thành viên BQT Link download dự án: Bạn cần đăng nhập để thấy link _____________________________ Đã 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 và 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 Bạn cần đăng nhập để thấy link để 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: 23/3/20

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: Bạn cần đăng nhập để thấy link 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: Bạn cần đăng nhập để thấy link 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: Bạn cần đăng nhập để thấy link 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: Bạn cần đăng nhập để thấy link Tôi đề xuất code sau. File demo: Bạn cần đăng nhập để thấy link 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 Bạn cần đăng nhập để thấy link : Code Module tiếng việt (main): Spoiler: Module tiếng việt 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: Spoiler: 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: Spoiler: 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):

NhanSu nói: 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 Bạn cần đăng nhập để thấy link (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. Nhấn để mở rộng...

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: Bạn cần đăng nhập để thấy link 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 N

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

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 ở Bạn cần đăng nhập để thấy link 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 T

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: Bạn cần đăng nhập để thấy link Thời gian tới, chúng tôi sẽ dịch đầy đủ về chuyên đề này, tạm thời thế đã nhé. N

Nguyen Kha Nam

VIP

@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 Constant	Value	Description
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: 9/4/20

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

gauchoigameonline nói: @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 Nhấn để mở rộng...

Tôi có thấy cách này khác gì với Bạn cần đăng nhập để thấy link đâu nhỉ.

• 1
• 2

Tiếp 1 of 2

Đi đến trang

Tới Tiếp Last Bạn phải đăng nhập hoặc đăng ký để bình luận. Chia sẻ: Facebook Twitter WhatsApp Email Link

• Trang chủ
• Diễn đàn
• Kỹ thuật xử lý Excel
• Lập trình VBA

Top