Thí nghiệm làm Msgbox bằng TV

sinhvienpy89

Mỗi ngày 1 điều mới
Hội viên mới
- Làm Msgbox thì mình không nói.
- Dùng các hàm API như các bác cao thủ thì không dám.Nhưng mình có làm theo bài này của bác Phatnq2002 nhưng mà không được.
hấy quý vị râm ran cái vụ hiển thị chữ có dấu tiếng Việt ở MsgBox quá, tôi bèn tham gia một chút xíu. Bảo đảm hiện chữ có dấu tiếng Việt hẳn hoi. Xài unicode nghen.

Quý vị chịu khó làm một cái table sau:

Name: tblMessages
Fields: messID (Text, 50), messContent (Text, 255)


messID: chứa một chuỗi để xác định nội dung thông báo, ví dụ: TRUNG_MASO
messContent: chứa nội dung thông báo, ví dụ: Mã số đã bị trùng, vui lòng nhập lại mã số khác.

Làm một cái sub hay function gì đó. Ở đây là sub ví dụ:

Public Sub ThongBao (messID As String)
Dim noidung
noidung = DLookup("messContent", "tblMessages", "messID = '" & messID & "'")
If IsNull(noidung) Then
MsgBox "This error is not recorded."
Else
MsgBox noidung
End If
End Sub


Ở đâu đó cần hiện thông báo thì gọi sub:

ThongBao TRUNG_MASO
Các bạn xem File đính kèm tìm nguyên nhân giùm.Thank nhiều lắm
 
Sửa lần cuối:
Ðề: Thí nghiệm làm Msgbox bằng TV

Private Sub cmdRun_Click()
Dim n As String
n = DLookup("ThongBaoID", "tblThongBao", "[Ma]='PW'")
MsgBox n
End Sub

Cái bạn làm đâu có giống với cái của bác Phat,mà không biết mọi người thế nào chứ mình làm nó có hiện tiếng việt đâu. Bởi vì khi gán biến noidung = Dlookup rồi dùng Msgbox để hiện thị thì nó mất tiếng việt rồi.
 
Ðề: Thí nghiệm làm Msgbox bằng TV

Nếu bạn dùng msgbox thì phải đổi font hệ thống thành font Unicode hổ trợ tiếng việt (tahoma, arial, times new roman, . . ).
Cách tốt nhất nếu muốn mang chương trình chạy trên cáci máy khác nhau mà hiện thông báo tiếng việt :
1. Viết code đổi fonts hệ thống.
hoặc
2. Tạo 1 form làm form thông báo để xuất ra các label hoặc textbox chứa nội dung thông báo. (cái này chủ động hơn)
 
Sửa lần cuối:
Ðề: Thí nghiệm làm Msgbox bằng TV

- Làm Msgbox thì mình không nói.
- Dùng các hàm API như các bác cao thủ thì không dám.Nhưng mình có làm theo bài này của bác Phatnq2002 nhưng mà không được.


Các bạn xem File đính kèm tìm nguyên nhân giùm.Thank nhiều lắm

Thấy các bạn cứ loay hoay với việc làm thông báo tiếng Việt, tôi xin có đôi dòng thế này
1/ Nếu muốn làm như phatnq2002 thì tham khảo cách viết của haquocquan
http://danketoan.com/forum/showthread.php?t=125684&page=2
2/ Nếu muốn dùng API, tôi gửi các bạn file hướng dẫn này để các bạn ứng dụng
Khó khăn hay thắc mắc gì liên hệ lại với tôi để được hướng dẫn thêm
Chúc vui
Thân
Email : bachdanggiang_2006@yahoo.com
Mobile : 0982136217

P/S : Tài liệu có trong bài là dựa theo các bài của Nguyễn Duy Tuân và Đỗ Nguyên Bình của giaiphapexcel.com
 

Đính kèm

  • Huong dan lam MsgBox Tieng Viet.rar
    24.1 KB · Lượt xem: 230
Sửa lần cuối:
Ðề: Thí nghiệm làm Msgbox bằng TV

Thanks bác, trước nay em toàn dùng marco, ưu điểm nhanh gọn ,phải cái khi chạy load lần đầu hơi chậm.
-----------------------------------------------------------------------------------------
Mới phát hiện hàm này không hiển thị được chứ Ý (Nó thành u)
 
Sửa lần cuối:
Ðề: Thí nghiệm làm Msgbox bằng TV

Thanks bác, trước nay em toàn dùng marco, ưu điểm nhanh gọn ,phải cái khi chạy load lần đầu hơi chậm.
-----------------------------------------------------------------------------------------
Mới phát hiện hàm này không hiển thị được chứ Ý (Nó thành u)

Kiểm tra lại và đọc kỹ hướng dẫn
 
Ðề: Thí nghiệm làm Msgbox bằng TV

61580491.jpg


Đã kiểm tra rất kỹ rồi bác ơi ,em chụp nguyên cái msg từ ví dụ của bác sẽ thấy vùng khoanh tròn.
Và sau đó em phát hiện thêm :
1. Chữ MÃ thành chữ MA (Không có dấu ngã được)
2. Chữ tồn viết thường thì không sao,viết hoa thành TrnN.
 
Ðề: Thí nghiệm làm Msgbox bằng TV

61580491.jpg


Đã kiểm tra rất kỹ rồi bác ơi ,em chụp nguyên cái msg từ ví dụ của bác sẽ thấy vùng khoanh tròn.
Và sau đó em phát hiện thêm :
1. Chữ MÃ thành chữ MA (Không có dấu ngã được)
2. Chữ tồn viết thường thì không sao,viết hoa thành TrnN.
Hà hà hình như là Font hệ thống của Win7 là Se.. mình không rõ.Chứ bạn coi mình thử nghiệm trên WinXP nè.

1.jpg


Nhưng mà xin hỏi tác giả có bí quyết nào để đánh như thế này không?Nhìn mãi mà không thấy quy luật.Khó quá anh Xuanthanh ơi

i.png


Thanh Title của bạn nó hiện thị ngon lành chứ WInXP thì nó có được đâu.Được cái này mất cái kia he he

 
Sửa lần cuối:
Ðề: Thí nghiệm làm Msgbox bằng TV

Win Xp ngon lành à ,may quá. Thanh Title mình để tiếng anh hết lên không lo.
Có quy luật gõ gì đâu. Bạn chuyển bộ gõ về VNI Windows,rồi gõ bình thường sẽ ra những ký tự kỳ quái đó. Còn muốn nhìn rõ thành tiếng việt trong VB thì vào VB Tools/Options/ Editor Format / Chọn cái Font Vni ấy.
 
Ðề: Thí nghiệm làm Msgbox bằng TV

Win Xp ngon lành à ,may quá. Thanh Title mình để tiếng anh hết lên không lo.
Có quy luật gõ gì đâu. Bạn chuyển bộ gõ về VNI Windows,rồi gõ bình thường sẽ ra những ký tự kỳ quái đó. Còn muốn nhìn rõ thành tiếng việt trong VB thì vào VB Tools/Options/ Editor Format / Chọn cái Font Vni ấy.
Mình đang dùng OFFICE 2003, WINXP hoặc WIN SER 2003; sử dụng UNICODE.
Theo link: http://danketoan.com/forum/showthread.php?t=125684&page=2
thì OK về UNICODE.
Còn một cách khác: mình dùng VK SANS SERIF(TCVN3) trong viết CODE. Cũng hiện tiếng việt như thường.
Mình có hai đoạn code (sưu tầm được gửi các bạn), các bạn có thể tùy biến để tạo msgbox tiếng việt xem được không. Nếu được, cho mình xin DEMO nhé.
Code1: VNI to UNICODE
Mã:
Option Compare Database 

Public Function VNIUNI(chuoi) 
Dim st As String 
Dim a As Byte 
If Len(Trim(chuoi)) < 1 Or IsNull(chuoi) Then 
VNIUNI = "" 
Else 
st = "" 
For i = 1 To Len(Trim(chuoi)) 
st = st + Ascii_text(Right(Left(chuoi, i), 1)) 
Next 
VNIUNI = ConvertToUnicode(st) 
End If 

End Function 

Public Function Ascii_text(ch As String) 
VNIarray = Array(97, 225, 224, 945, 223, 915, 226, 960, 931, 963, 181, 964, 934, 920, 937, 948, 8734, 966, 101, 233, 232, 252, 228, 229, 234, 235, 239, 196, 197, 188, 111, 243, 242, 230, 198, 246, 244, 251, 255, 214, 220, 162, 8804, 8992, 8993, 247, 8776, 176, 105, 237, 238, 8976, 172, 189, 121, 949, 8745, 8801, 177, 8805, 161, 117, 250, 249, 163, 165, 8359, 402, 241, 209, 170, 186, 191, 171, 178, 8319, 8729, 9632, 8730, 183) 
UNIarray = Array("a", "a1", "a2", "a3", "a4", "a5", "a6", "a61", "a62", "a63", "a64", "a65", "a8", "a81", "a82", "a83", "a84", "a85", "e", "e1", "e2", "e3", "e4", "e5", "e6", "e61", "e62", "e63", "e64", "e65", "o", "o1", "o2", "o3", "o4", "o5", "o6", "o61", "o62", "o63", "o64", "o65", "o7", "o71", "o72", "o73", "o74", "o75", "i", "i1", "i2", "i3", "i4", "i5", "y", "y1", "y2", "y3", "y4", "y5", "d9", "u", "u1", "u2", "u3", "u4", "u5", "u7", "u71", "u72", "u73", "u74", "u75", "D9", "A6", "A8", "O6", "E6", "U7", "O7") 
For i = 0 To 79 
If AscW(ch) = VNIarray(i) Then 
ch = UNIarray(i) 
End If 
Next 
Ascii_text = ch 
End Function 

Public Function ConvertToUnicode(sText As String) 
Dim i As Integer, j As Integer 
Dim sCurChar As String, sPreChar As String, sPreTxt As String 
For j = 1 To 2 
For i = 2 To Len(sText) 
sCurChar = Mid(sText, i, 1) 
sPreTxt = Left(sText, i - 2) 
sPreChar = Mid(sText, i - 1, 1) 
Select Case sCurChar 
Case "1" 
Select Case sPreChar 
'a 
Case "a": sText = sPreTxt & ChrW$(&HE1) & Right(sText, Len(sText) - i) 
Case "A": sText = sPreTxt & ChrW$(&HC1) & Right(sText, Len(sText) - i) 
Case ChrW$(&HE2): sText = sPreTxt & ChrW$(&H1EA5) & Right(sText, Len(sText) - i) 
Case ChrW$(&HC2): sText = sPreTxt & ChrW$(&H1EA4) & Right(sText, Len(sText) - i) 
Case ChrW$(&H103): sText = sPreTxt & ChrW$(&H1EAF) & Right(sText, Len(sText) - i) 
Case ChrW$(&H102): sText = sPreTxt & ChrW$(&H1EAE) & Right(sText, Len(sText) - i) 

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

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

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

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

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

End Select 

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

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

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

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

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

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

End Select 

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

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

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

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

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

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

End Select 

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

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

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

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

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

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

Case "5" 
Select Case sPreChar 
'a 
Case "a": sText = sPreTxt & ChrW$(&H1EA1) & Right(sText, Len(sText) - i) 
Case "A": sText = sPreTxt & ChrW$(&H1EA0) & Right(sText, Len(sText) - i) 
Case ChrW$(&HE2): sText = sPreTxt & ChrW$(&H1EAD) & Right(sText, Len(sText) - i) 
Case ChrW$(&HC2): sText = sPreTxt & ChrW$(&H1EAC) & Right(sText, Len(sText) - i) 
Case ChrW$(&H103): sText = sPreTxt & ChrW$(&H1EB7) & Right(sText, Len(sText) - i) 
Case ChrW$(&H102): sText = sPreTxt & ChrW$(&H1EB6) & Right(sText, Len(sText) - i) 

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

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

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

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

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

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

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

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

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

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

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

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

End Select 
Next i 
Next j 
ConvertToUnicode = sText 
End Function

CODE2: TCVN3 to UNICODE
Mã:
Option Explicit
Function ToUnicode(txtString As String, Optional isReversed As Boolean = False, Optional isISO As Boolean = False) As String
    ' This function will do the conversion of text string into unicode
    Dim iStr As String, repTxt As String, mText As String
    Dim i As Long, j As Long
    Dim iUnicode As Variant ' array to keep unicode char set
    Dim iTCVN As Variant ' array to keep TCVN char set
    Dim iProcList() As String ' array to keep what to convert
    
    'parse the parameter into this local variable
    iStr = txtString
    mText = txtString
    
    iUnicode = Array(225, 224, 7843, 227, 7841, 259, 7855, 7857, 7859, 7861, 7863, 226, _
        7845, 7847, 7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 234, 7871, 7873, 7875, _
        7877, 7879, 237, 236, 7881, 297, 7883, 243, 242, 7887, 245, 7885, 244, 7889, 7891, _
        7893, 7895, 7897, 417, 7899, 7901, 7903, 7905, 7907, 250, 249, 7911, 361, 7909, _
        432, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, 7925, 273, 193, 192, 195, _
        258, 194, 212, 416, 431, 272)
    
    iTCVN = Array(184, 181, 182, 183, 185, 168, 190, 187, 188, 189, 198, 169, 202, 199, 200, _
        201, 203, 208, 204, 206, 207, 209, 170, 213, 210, 211, 212, 214, 221, 215, 216, 220, _
        222, 227, 223, 225, 226, 228, 171, 232, 229, 230, 231, 233, 172, 237, 234, 235, 236, _
        238, 243, 239, 241, 242, 244, 173, 248, 245, 246, 247, 249, 253, 250, 251, 252, 254, _
        174, 193, 192, 195, 161, 162, 164, 165, 166, 167)
    
    ' Reenlarge the array
    ReDim iProcList(1, 133)
    ' process the vowel only and covert to asc code
    For i = 1 To Len(mText)
        repTxt = Mid(mText, i, 1)
        If AscW(repTxt) > 122 Then
            iStr = Replace(iStr, repTxt, "[" & AscW(repTxt) & "]")
            mText = Replace(mText, repTxt, " ")
            ' write the processed list
            iProcList(1, j) = "[" & AscW(repTxt) & "]"
            If isISO Then
                iProcList(0, j) = GetElementNo(AscW(repTxt), iUnicode)
            Else
                If isReversed Then
                    iProcList(0, j) = GetElementNo(AscW(repTxt), iUnicode)
                Else
                    iProcList(0, j) = GetElementNo(AscW(repTxt), iTCVN)
                End If
            End If
            j = j + 1
        End If
    Next
    If j = 0 Then
        ToUnicode = txtString
        Exit Function
    End If
    ReDim Preserve iProcList(1, j - 1)
    ' now convert to unicode
    For i = 0 To UBound(iProcList, 2)
        If isReversed Then
            iStr = Replace(iStr, iProcList(1, i), ChrW(iTCVN(Val(iProcList(0, i)))))
        Else
            If isISO Then
                iStr = Replace(iStr, iProcList(1, i), "&#" & iUnicode(Val(iProcList(0, i))) & ";")
            Else
                iStr = Replace(iStr, iProcList(1, i), ChrW(iUnicode(Val(iProcList(0, i)))))
            End If
        End If
    Next
fExit:
    ToUnicode = iStr
End Function

Private Function GetElementNo(iTxt As Long, iObj As Variant) As String
    Dim i As Long
    For i = 0 To UBound(iObj)
        If iTxt = iObj(i) Then
            GetElementNo = CStr(i)
            Exit For
        End If
    Next
End Function
 
Sửa lần cuối:
Ðề: Thí nghiệm làm Msgbox bằng TV

Đã thử nghiệm Code 2 thành công nhưng chỉ thích hợp với những thông báo viết chữ thường,nếu viết hoa những từ có dấu nó sẽ bị thu nhỏ. Và vẫn bị lỗi 1 số chữ như chữ GÌ, MÃ... trên Win 7 nhé.
Do mình không up được file lên thêm code như sau :

Function MsgBoxUni(ByVal PromptUni As Variant, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, Optional ByVal TitleUni As Variant = vbNullString) As VbMsgBoxResult
Dim BStrMsg, BStrTitle
BStrMsg = StrConv(PromptUni, vbUnicode)
BStrTitle = StrConv(TitleUni, vbUnicode)
MsgBoxUni = MessageBoxW(GetActiveWindow, BStrMsg, BStrTitle, Buttons)
End Function

Và đây là câu thông báo tiếng việt :
MsgBoxUni ToUnicode("T¤I QUYÕT §I CH¥I T×M G× §¢Y, RåI ", False, False), vbInformation, ToUnicode("CUSTOMER RELATION MANAGEMENT SYSTEM")
 
Ðề: Thí nghiệm làm Msgbox bằng TV

- Làm Msgbox thì mình không nói.
- Dùng các hàm API như các bác cao thủ thì không dám.Nhưng mình có làm theo bài này của bác Phatnq2002 nhưng mà không được.
Các bạn xem File đính kèm tìm nguyên nhân giùm.Thank nhiều lắm
Cái này bạn xem coi có đáp ứng được yêu cầu không?
http://www.mediafire.com/?tucbbrsrq8g5cq1
 

CẨM NANG KẾ TOÁN TRƯỞNG


Liên hệ: 090.6969.247

KÊNH YOUTUBE DKT

Cách làm file Excel quản lý lãi vay

Đăng ký kênh nhé cả nhà

SÁCH QUYẾT TOÁN THUẾ


Liên hệ: 090.6969.247

Top