Gõ tiếng việt trong VBA

tuhocvba · 20/7/21

Hiện nay code VBA xử lý các chuỗi string lôi unicode, convert sang dạng chuẩn unicode có chưa nhỉ?
Mình gặp văn bản có chuỗi ký tự như sau:

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

Ô A2 là kết quả của code sau:

Mã:

Sub a1()
    Dim i As Long, s As String, kq As String, s2 As String
    s = Cells(1, 1).Text
    For i = 1 To Len(s) Step 1
    s2 = Mid(s, i, 1)
    kq = kq & CharToUnicode(s2)
    Next i
    Cells(2, 1).Value = "'" & kq
End Sub
Function CharToUnicode(strChar As String)
    Dim lngUnicode As Long
    lngUnicode = AscW(strChar)
    CharToUnicode = lngUnicode
End Function

Thông qua hàm ChrW ta kiểm tra ChrW(234) là chữ ê, và ChrW(803) là #.
Tất nhiên giá trị mong muốn đúng ra phải là chuỗi ký tự sau:
Ô A3 là ký tự nhập đúng.
Ô A4 là kết quả của chạy code trên sửa đầu vào là ô A3 và nơi ghi kết quả là ô A4. Ô A5 là kết quả của ChrW(7879).

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

Vấn đề là mình không biết người dùng đã gõ như thế nào để ra ký tự ở ô A1. Cho nên bây giờ nói muốn có hàm convert ra kết quả ô A3 cũng không biết làm sao.
Nếu trên Unikey, ấn ctr + shift + F6.

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

Ấn ctr+c copy lại đoạn ký tự ô A1. Tại giao diện này của unikey ấn chuyển mã.
Vào Excel ấn ctr+V để paste, ta sẽ được chuỗi ký tự đúng như kỳ vọng.

Tóm lại vấn đề muốn bàn là: Input như ô A1, làm sao ra được output như ô A3.

tuhocvba · 20/7/21

Bổ sung thêm trường hợp khác:

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

tuhocvba · 21/7/21

Từ các bài viết #21, #22, mặc dù chưa biết người dùng đã gõ như thế nào, nhưng dựa trên các dữ kiện đã nêu có thể thấy rằng khi các nguyên âm đứng cùng với ký tự có mã 803 thì nó tạo nên một ký tự có dấu nặng gần giống với Unicode.
Do đó tôi sẽ xây dựng hàm để fix chuẩn dấu nặng này.
Phần màu vàng là INPUT (Lỗi sai thường gặp trên word), phần màu xanh là OUTPUT (đưa ra dạng Unicode chuẩn) :

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

Mã:

'aw 803 => awj
Function fixloidaunang(ByVal s As String) As String

CharCodeloi = Array(ChrW(97) & ChrW(803), ChrW(259) & ChrW(803), ChrW(226) & ChrW(803), ChrW(101) & ChrW(803), _
                    ChrW(234) & ChrW(803), ChrW(111) & ChrW(803), ChrW(244) & ChrW(803), ChrW(417) & ChrW(803), _
                    ChrW(117) & ChrW(803), ChrW(432) & ChrW(803), ChrW(105) & ChrW(803), ChrW(121) & ChrW(803))
unikeychuan = Array(ChrW(7841), ChrW(7863), ChrW(7853), ChrW(7865), ChrW(7879), ChrW(7885), ChrW(7897), ChrW(7907), _
                    ChrW(7909), ChrW(7921), ChrW(7883), ChrW(7925))
fixloidaunang = s
For i = 0 To UBound(unikeychuan)
    fixloidaunang = Replace(fixloidaunang, CharCodeloi(i), unikeychuan(i))
    fixloidaunang = Replace(fixloidaunang, UCase(CharCodeloi(i)), UCase(unikeychuan(i)))
Next i

End Function

tuhocvba · 21/7/21

Vẫn vấn đề trên, cùng phương pháp dò lỗi như trên, tôi phát hiện ra rằng: Dấu hỏi mã 777. Dấu sắc mã 769. Dấu huyền mã 768.
Các dấu này mà đứng trước nguyên âm sẽ làm cho trông là vậy mà không phải vậy. Cần phải replace như bước trên.

tuhocvba · 21/7/21

Fix lỗi dấu huyền:

Mã:

'aw 768 => awf
Function fixloidauhuyen(ByVal s As String) As String
'Dau huyen loi: 768
CharCodeloi = Array(ChrW(97) & ChrW(768), ChrW(259) & ChrW(768), ChrW(226) & ChrW(768), ChrW(101) & ChrW(768), _
                    ChrW(234) & ChrW(768), ChrW(111) & ChrW(768), ChrW(244) & ChrW(768), ChrW(417) & ChrW(768), _
                    ChrW(117) & ChrW(768), ChrW(432) & ChrW(768), ChrW(105) & ChrW(768), ChrW(121) & ChrW(768))

unikeychuan = Array(ChrW(224), ChrW(7857), ChrW(7847), ChrW(232), ChrW(7873), _
ChrW(242), ChrW(7891), ChrW(7901), ChrW(249), ChrW(7915), ChrW(236), ChrW(7923))

fixloidauhuyen = s
For i = 0 To UBound(unikeychuan)
    fixloidauhuyen = Replace(fixloidauhuyen, CharCodeloi(i), unikeychuan(i))
    fixloidauhuyen = Replace(fixloidauhuyen, UCase(CharCodeloi(i)), UCase(unikeychuan(i)))
Next i

End Function

tuhocvba · 21/7/21

Fix lỗi dấu sắc:

Mã:

'aw 769 => aws
Function fixloidausac(ByVal s As String) As String
'Dau sac loi: 769
CharCodeloi = Array(ChrW(97) & ChrW(769), ChrW(259) & ChrW(769), ChrW(226) & ChrW(769), ChrW(101) & ChrW(769), _
ChrW(234) & ChrW(769), ChrW(111) & ChrW(769), ChrW(244) & ChrW(769), ChrW(417) & ChrW(769), _
ChrW(117) & ChrW(769), ChrW(432) & ChrW(769), ChrW(105) & ChrW(769), ChrW(121) & ChrW(769))

unikeychuan = Array(ChrW(225), ChrW(7855), ChrW(7845), ChrW(233), ChrW(7871), ChrW(243), _
ChrW(7889), ChrW(7899), ChrW(250), ChrW(7913), ChrW(237), ChrW(253))

fixloidausac = s
For i = 0 To UBound(unikeychuan)
    fixloidausac = Replace(fixloidausac, CharCodeloi(i), unikeychuan(i))
    fixloidausac = Replace(fixloidausac, UCase(CharCodeloi(i)), UCase(unikeychuan(i)))
Next i

End Function

tuhocvba · 21/7/21

Fix dấu hỏi:

Mã:

'aw 777 => awr
Function fixloidauhoi(ByVal s As String) As String

CharCodeloi = Array(ChrW(97) & ChrW(777), ChrW(259) & ChrW(777), ChrW(226) & ChrW(777), ChrW(101) & ChrW(777), _
                    ChrW(234) & ChrW(777), ChrW(111) & ChrW(777), ChrW(244) & ChrW(777), ChrW(417) & ChrW(777), _
                    ChrW(117) & ChrW(777), ChrW(432) & ChrW(777), ChrW(105) & ChrW(777), ChrW(121) & ChrW(777))
                    
unikeychuan = Array(ChrW(7843), ChrW(7859), ChrW(7849), ChrW(7867), ChrW(7875), ChrW(7887), _
ChrW(7893), ChrW(7903), ChrW(7911), ChrW(7917), ChrW(7881), ChrW(7927))

fixloidauhoi = s
For i = 0 To UBound(unikeychuan)
    fixloidauhoi = Replace(fixloidauhoi, CharCodeloi(i), unikeychuan(i))
    fixloidauhoi = Replace(fixloidauhoi, UCase(CharCodeloi(i)), UCase(unikeychuan(i)))
Next i

End Function

tuhocvba · 21/7/21

Fix lỗi dấu ngã:

Mã:

'aw 771 => awx
Function fixloidaunga(ByVal s As String) As String

CharCodeloi = Array(ChrW(97) & ChrW(771), ChrW(259) & ChrW(771), ChrW(226) & ChrW(771), ChrW(101) & ChrW(771), _
                    ChrW(234) & ChrW(771), ChrW(111) & ChrW(771), ChrW(244) & ChrW(771), ChrW(417) & ChrW(771), _
                    ChrW(117) & ChrW(771), ChrW(432) & ChrW(771), ChrW(105) & ChrW(771), ChrW(121) & ChrW(771))
                    
                    
unikeychuan = Array(ChrW(227), ChrW(7861), ChrW(7851), ChrW(7869), ChrW(7877), ChrW(245), _
ChrW(7895), ChrW(7905), ChrW(361), ChrW(7919), ChrW(297), ChrW(7929))


fixloidaunga = s
For i = 0 To UBound(unikeychuan)
    fixloidaunga = Replace(fixloidaunga, CharCodeloi(i), unikeychuan(i))
    fixloidaunga = Replace(fixloidaunga, UCase(CharCodeloi(i)), UCase(unikeychuan(i)))
Next i

End Function

tuhocvba · 21/7/21

Hợp code các bài viết từ #21 ~ #28:

Mã:

Function fixloiword(ByVal s As String) As String
    Dim kq As String
    kq = fixloidaunang(s)
    kq = fixloidauhuyen(kq)
    kq = fixloidausac(kq)
    kq = fixloidauhoi(kq)
    fixloiword = fixloidaunga(kq)
    
End Function

'aw 803 => awj
Private Function fixloidaunang(ByVal s As String) As String

CharCodeloi = Array(ChrW(97) & ChrW(803), ChrW(259) & ChrW(803), ChrW(226) & ChrW(803), ChrW(101) & ChrW(803), _
                    ChrW(234) & ChrW(803), ChrW(111) & ChrW(803), ChrW(244) & ChrW(803), ChrW(417) & ChrW(803), _
                    ChrW(117) & ChrW(803), ChrW(432) & ChrW(803), ChrW(105) & ChrW(803), ChrW(121) & ChrW(803))
unikeychuan = Array(ChrW(7841), ChrW(7863), ChrW(7853), ChrW(7865), ChrW(7879), ChrW(7885), ChrW(7897), ChrW(7907), _
                    ChrW(7909), ChrW(7921), ChrW(7883), ChrW(7925))
fixloidaunang = s
For i = 0 To UBound(unikeychuan)
    fixloidaunang = Replace(fixloidaunang, CharCodeloi(i), unikeychuan(i))
    fixloidaunang = Replace(fixloidaunang, UCase(CharCodeloi(i)), UCase(unikeychuan(i)))
Next i

End Function

'aw 768 => awf
Private Function fixloidauhuyen(ByVal s As String) As String
'Dau huyen loi: 768
CharCodeloi = Array(ChrW(97) & ChrW(768), ChrW(259) & ChrW(768), ChrW(226) & ChrW(768), ChrW(101) & ChrW(768), _
                    ChrW(234) & ChrW(768), ChrW(111) & ChrW(768), ChrW(244) & ChrW(768), ChrW(417) & ChrW(768), _
                    ChrW(117) & ChrW(768), ChrW(432) & ChrW(768), ChrW(105) & ChrW(768), ChrW(121) & ChrW(768))

unikeychuan = Array(ChrW(224), ChrW(7857), ChrW(7847), ChrW(232), ChrW(7873), _
ChrW(242), ChrW(7891), ChrW(7901), ChrW(249), ChrW(7915), ChrW(236), ChrW(7923))

fixloidauhuyen = s
For i = 0 To UBound(unikeychuan)
    fixloidauhuyen = Replace(fixloidauhuyen, CharCodeloi(i), unikeychuan(i))
    fixloidauhuyen = Replace(fixloidauhuyen, UCase(CharCodeloi(i)), UCase(unikeychuan(i)))
Next i

End Function

'aw 769 => aws
Private Function fixloidausac(ByVal s As String) As String
'Dau sac loi: 769
CharCodeloi = Array(ChrW(97) & ChrW(769), ChrW(259) & ChrW(769), ChrW(226) & ChrW(769), ChrW(101) & ChrW(769), _
ChrW(234) & ChrW(769), ChrW(111) & ChrW(769), ChrW(244) & ChrW(769), ChrW(417) & ChrW(769), _
ChrW(117) & ChrW(769), ChrW(432) & ChrW(769), ChrW(105) & ChrW(769), ChrW(121) & ChrW(769))

unikeychuan = Array(ChrW(225), ChrW(7855), ChrW(7845), ChrW(233), ChrW(7871), ChrW(243), _
ChrW(7889), ChrW(7899), ChrW(250), ChrW(7913), ChrW(237), ChrW(253))

fixloidausac = s
For i = 0 To UBound(unikeychuan)
    fixloidausac = Replace(fixloidausac, CharCodeloi(i), unikeychuan(i))
    fixloidausac = Replace(fixloidausac, UCase(CharCodeloi(i)), UCase(unikeychuan(i)))
Next i

End Function

'aw 777 => awr
Private Function fixloidauhoi(ByVal s As String) As String

CharCodeloi = Array(ChrW(97) & ChrW(777), ChrW(259) & ChrW(777), ChrW(226) & ChrW(777), ChrW(101) & ChrW(777), _
                    ChrW(234) & ChrW(777), ChrW(111) & ChrW(777), ChrW(244) & ChrW(777), ChrW(417) & ChrW(777), _
                    ChrW(117) & ChrW(777), ChrW(432) & ChrW(777), ChrW(105) & ChrW(777), ChrW(121) & ChrW(777))
                    
unikeychuan = Array(ChrW(7843), ChrW(7859), ChrW(7849), ChrW(7867), ChrW(7875), ChrW(7887), _
ChrW(7893), ChrW(7903), ChrW(7911), ChrW(7917), ChrW(7881), ChrW(7927))

fixloidauhoi = s
For i = 0 To UBound(unikeychuan)
    fixloidauhoi = Replace(fixloidauhoi, CharCodeloi(i), unikeychuan(i))
    fixloidauhoi = Replace(fixloidauhoi, UCase(CharCodeloi(i)), UCase(unikeychuan(i)))
Next i

End Function
'aw 771 => awx
Private Function fixloidaunga(ByVal s As String) As String

CharCodeloi = Array(ChrW(97) & ChrW(771), ChrW(259) & ChrW(771), ChrW(226) & ChrW(771), ChrW(101) & ChrW(771), _
                    ChrW(234) & ChrW(771), ChrW(111) & ChrW(771), ChrW(244) & ChrW(771), ChrW(417) & ChrW(771), _
                    ChrW(117) & ChrW(771), ChrW(432) & ChrW(771), ChrW(105) & ChrW(771), ChrW(121) & ChrW(771))
                    
                    
unikeychuan = Array(ChrW(227), ChrW(7861), ChrW(7851), ChrW(7869), ChrW(7877), ChrW(245), _
ChrW(7895), ChrW(7905), ChrW(361), ChrW(7919), ChrW(297), ChrW(7929))


fixloidaunga = s
For i = 0 To UBound(unikeychuan)
    fixloidaunga = Replace(fixloidaunga, CharCodeloi(i), unikeychuan(i))
    fixloidaunga = Replace(fixloidaunga, UCase(CharCodeloi(i)), UCase(unikeychuan(i)))
Next i

End Function

quốc bình · 2/7/22

tuhocvba nói:
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

Mình dùng code như sau:

Mã:

Private Sub CommandButton1_Click()
      Dim Text As String
      Text = "Bajn cos muoosn xoas?"
      Application.Assistant.DoAlert "THÔNG BÁO", UniConvert(Text, "Telex"), 4, 4, 0, 0, 0
End Sub

Các bạn giúp mình với ạ, khi msgbox hiện ra thì click vào Ok sẽ cho xóa còn No thì không xóa thì làm sao ạ?
File ví dụ của mình đây ạ:

Bạn cần đăng nhập để thấy link

tuhocvba · 3/7/22

Mã:

Private Sub CommandButton1_Click()
      Dim text As String
      text = "Bajn cos muoosn xoas?"
      text = UniConvert(text, "Telex")
      With Application.Assistant
        Select Case .DoAlert("THONG BAO", text, 4, 4, 0, 0, 0)
            Case vbYes: MsgBox "Ban click yes" 'Call thutucXoa
            Case vbNo: MsgBox "Ban click No"    'Goto thoat:
        End Select
      End With
      
thoat:
End Sub

Nguồn:

Bạn cần đăng nhập để thấy link

phuongnamhp92 · 9/7/22

xin chia sẻ với các bạn một cách gõ và hiển thị viết tiếng việt trong vba

thêm một module chứa hàm tự tạo msgbox, inputbox
cài đặt font chữ VNI vào máy( em dùng VNI-times) => điều chỉnh VBE option font thành vni
sử dụng unikey gõ tiếng việt, đổi bảng mã thành VNI windows

Mã:

Option Base 1
#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 MsgBoxW(ByVal Prompt As String, _
                                  Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _
                                  Optional ByVal Title As String = "Microsoft Excel") As VbMsgBoxResult

    MsgBoxW = MessageBoxW(GetFocus(), StrPtr(VniToUni(Prompt)), StrPtr(VniToUni(Title)), Buttons)
End Function

Public Function InputboxW(ByVal Prompt As String, Optional ByVal Title As String = "Microsoft Excel", _
                                                Optional ByVal Default As String) As Variant
     InputboxW = Application.InputBox(VniToUni(Prompt), VniToUni(Title))
End Function

Function VniToUni(Str$) As String
       Dim VNI$, UNI$, I&, sUni$, arrUNI() As String
       VNI = "aù,aø,aû,aõ,aï,aâ,aê,aá,aà,aå,aã,aä,aé,aè,aú,aü,aë,AÙ,AØ,AÛ,AÕ,AÏ,AÂ,AÊ,AÁ,AÀ,AÅ,AÃ,AÄ,AÉ,AÈ,AÚ,AÜ,AË,eù,eø,eû,eõ,eï,eâ,eá,eà,eå,eã,eä,EÙ,EØ,EÛ,EÕ,EÏ,EÂ,EÁ,EÀ,EÅ,EÃ,EÄ,í ,ì ,æ ,ó ,ò ,Í ,Ì ,Æ ,Ó ,Ò ,où,oø,oû,oõ,oï,oâ,ô,oá,oà,oå,oã,oä,ôù,ôø,ôû,ôõ,ôï,OÙ,OØ,OÛ,OÕ,OÏ,OÂ,Ô ,OÁ,OÀ,OÅ,OÃ,OÄ,ÔÙ,ÔØ,ÔÛ,ÔÕ,ÔÏ,uù,uø,uû,uõ,uï,ö ,öù,öø,öû,öõ,öï,UÙ,UØ,UÛ,UÕ,UÏ,Ö ,ÖÙ,ÖØ,ÖÛ,ÖÕ,ÖÏ,yù,yø,yû,yõ,î ,YÙ,YØ,YÛ,YÕ,Î ,ñ ,Ñ "
       UNI = "E1,E0,1EA3,E3,1EA1,E2,103,1EA5,1EA7,1EA9,1EAB,1EAD,1EAF,1EB1,1EB3,1EB5,1EB7,C1,C0,1EA2,C3,1EA0,C2,102,1EA4,1EA6,1EA8,1EAA,1EAC,1EAE,1EB0,1EB2,1EB4,1EB6,E9,E8,1EBB,1EBD,1EB9,EA,1EBF,1EC1,1EC3,1EC5,1EC7,C9,C8,1EBA,1EBC,1EB8,CA,1EBE,1EC0,1EC2,1EC4,1EC6,ED,EC,1EC9,129,1ECB,CD,CC,1EC8,128,1ECA,F3,F2,1ECF,F5,1ECD,F4,1A1,1ED1,1ED3,1ED5,1ED7,1ED9,1EDB,1EDD,1EDF,1EE1,1EE3,D3,D2,1ECE,D5,1ECC,D4,1A0,1ED0,1ED2,1ED4,1ED6,1ED8,1EDA,1EDC,1EDE,1EE0,1EE2,FA,F9,1EE7,169,1EE5,1B0,1EE9,1EEB,1EED,1EEF,1EF1,DA,D9,1EE6,168,1EE4,1AF,1EE8,1EEA,1EEC,1EEE,1EF0,FD,1EF3,1EF7,1EF9,1EF5,DD,1EF2,1EF6,1EF8,1EF4,111,110"
       arrUNI = Split(UNI, ",")
       For I = 1 To Len(Str)
              If InStr(VNI, Mid(Str, I, 2)) > 0 And Len(Mid(Str, I, 2)) = 2 Then
                     sUni = sUni & ChrW("&h" & arrUNI(InStr(VNI, Mid(Str, I, 2)) \ 3))
                     I = I + 1
              ElseIf InStr(VNI, Mid(Str, I, 1) & " ") > 0 Then
                     sUni = sUni & ChrW("&h" & arrUNI(InStr(VNI, Mid(Str, I, 1) & " ") \ 3))
              End If
              If InStr(VNI, Mid(Str, I, 1)) = 0 Or InStr("a,A,e,E,o,O,u,U,y,Y, ", Mid(Str, I, 1)) > 0 Then sUni = sUni & Mid(Str, I, 1)
       Next
       VniToUni = sUni
End Function

P/S: em không biết cách chèn hình ảnh vào bài viết!

Bạn cần đăng nhập để thấy link

Gõ tiếng việt trong VBA

tuhocvba

Administrator

tuhocvba

Administrator

tuhocvba

Administrator

tuhocvba

Administrator

tuhocvba

Administrator

tuhocvba

Administrator

tuhocvba

Administrator

tuhocvba

Administrator

tuhocvba

Administrator

quốc bình

Yêu THVBA

tuhocvba

Administrator

phuongnamhp92

Yêu THVBA