Unicode tiếng Việt trong VBA Excel

Liên hệ QC
P

phamduylong

-
Thành viên đã mất
Tham gia
30/12/06
Bài viết
918
Được thích
2,368
Nghề nghiệp
Giáo viên
Unicode bây giờ phải xác định là font chính khi nhập dữ liệu. Khổ nổi có một số ứng dụng chưa hỗ trợ tốt font này, trong đó có VBA Excel. Muốn VBA gởi vào ô B1 chuỗi "Lập trình với Excel" không đơn giản chút nào vì khi nhập Cells(1,2)="Lập trình với Excel" nó lại trở thành Cells(1,2)="L?p trình v?i Excel". Những dấu ? đó là những ký tự mà mã của nó vượt ngưỡng 255.
Vấn đề này nhiều bạn đã đưa lên diễn đàn nhưng ở nhiều bài khác nhau, tôi mở chuyên mục này để chúng ta cùng tham gia để có thể sử dụng Unicode đễ dàng hơn.
Qua học hỏi từ diễn đàn và vận dụng vào lập trình VBA Excel, tôi viết Unicode tiếng Việt bằng 3 cách. Xin nêu lên và các bạn bổ sung thêm:
1. Nhập chuỗi vào 1 ô trên vào bảng tính, viết lệnh truy xuất nó. Ví dụ nhập vào ô A1 của sheet2 câu trên. Câu lệnh viết:
Cells(1, 2) = Sheets("Sheet2").Cells(1,1)
Cách này đơn giản, nhưng bảng tính phải có 1 sheet chứa các chuỗi này. Nếu có ai đó chỉnh, xóa dữ liệu thì hỏng.
2. Dùng phép nối chuỗi và hàm ChrW để viết:
Câu trên viết thành:
Cells(1,2)= L" & ChrW(7853) & "p trình v" & ChrW(7899) & "i Excel"
Cách này rắc rối vì phải biết mã ậ=7953, ớ=7899, nhưng nó được viết ngay trong module, người sử dụng khó thay đổi được (bạn tham khảo bảng mã trong tập tin CodeUnicode.xls).
3. Dùng 1 hàm tự viết để hỗ trợ cách 2 (hàm UniVba). Cách sử dụng như sau:
- Nhập chuỗi cần viết vào 1 ô trong bàng tính. Ví dụ nhập vào ô A1 chuỗi “Xử lý tiếng Việt”.
- Ô B1 nhập công thức =univba(A1), hàm sẽ cho kết quả:
"X" & ChrW(7917) & " lý ti" & ChrW(7871) & "ng Vi" & ChrW(7879) & "t"
Hàm UniVba dò tìm từng ký tự trong chuỗi, nếu ký tự nào có mã > 255 sẽ chuyển thành ChrW(mã) và ghép chúng bằng phép &.
Bạn copy ô B1 và dán vào module, rất nhanh và chính xác.
Mã: 
‘===========
Function UniVba(TxtUni As String) As String
If TxtUni = "" Then
UniVba = """"""
Else
TxtUni = TxtUni & " "
If AscW(Left(TxtUni, 1)) < 256 Then UniVba = """"
For n = 1 To Len(TxtUni) - 1
uni1 = Mid(TxtUni, n, 1)
uni2 = AscW(Mid(TxtUni, n + 1, 1))
If AscW(uni1) > 255 And uni2 > 255 Then
UniVba = UniVba & "ChrW(" & AscW(uni1) & ") & "
ElseIf AscW(uni1) > 255 And uni2 < 256 Then
UniVba = UniVba & "ChrW(" & AscW(uni1) & ") & """
ElseIf AscW(uni1) < 256 And uni2 > 255 Then
UniVba = UniVba & uni1 & """ & "
Else
UniVba = UniVba & uni1
End If
Next
If Right(UniVba, 4) = " & """ Then
UniVba = Mid(UniVba, 1, Len(UniVba) - 4)
Else
UniVba = UniVba & """"
End If
End If
End Function
‘========
Các bạn tải tập tin CodeUnicode và UniVba về tham khảo.
 

File đính kèm

  • CodeUnicode.zip
    7.8 KB · Đọc: 3,964
  • UniVba.zip
    7.7 KB · Đọc: 3,235
Sắp xếp theo thời gian sắp xếp theo bầu chọn
langtu020690 đã viết:
Dear

Hiện tại các lable hay text thì e dùng hàm trên OK, xuất được tiếng việt, nhưng khi đặt cho form thì cũng bị lỗi, nhờ ad xem lại thử
View attachment 220073
Nhấp chuột vào đây để mở rộng...
Thử đoạn code này của anh @Nguyễn Duy Tuân thử xem được không?
Mã: 
Option Explicit
Private Const WM_SETTEXT = &HC
#If Win64 Then
    Declare PtrSafe Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcW" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) 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 = "L" & ChrW(7863) & "p l" & ChrW(7841) & "i tiêu " & ChrW(273) & ChrW(7873) & " cho dòng d" & ChrW(7919) & " li" & ChrW(7879) & "u"
    DefWindowProc hwnd, WM_SETTEXT, 0, StrPtr(sUnicode)
End Sub
 
Upvote 0
giaiphap đã viết:
Thử đoạn code này của anh @Nguyễn Duy Tuân thử xem được không?
Mã: 
Option Explicit
Private Const WM_SETTEXT = &HC
#If Win64 Then
    Declare PtrSafe Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcW" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) 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 = "L" & ChrW(7863) & "p l" & ChrW(7841) & "i tiêu " & ChrW(273) & ChrW(7873) & " cho dòng d" & ChrW(7919) & " li" & ChrW(7879) & "u"
    DefWindowProc hwnd, WM_SETTEXT, 0, StrPtr(sUnicode)
End Sub
Nhấp chuột vào đây để mở rộng...
Dear Ad
Sau khi thử đoạn đó vào thì khi chạy báo lỗi này
220079
 
Upvote 0
Office bác này là 64bit, nên khai báo trên thiếu từ khóa Private.
Bác add thêm Private và trước Declare 2 dòng đó
 
Upvote 0
À máy tôi Win7 32, Office 32bit 2007, chạy đoạn code của bác Tuân cũng không ra. Test với hàm API IsWindowUnicode thì ra FALSE (0), tức Ansi Window
Bạn giaiphap dùng Office gì vậy, chạy giúp tôi đoạn code này thử
Mã: 
Private Const WM_SETTEXT = &HC
#If VBA7 Then
    Private Declare PtrSafe Function DefWindowProc Lib "user32" Alias "DefWindowProcW" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function IsWindowUnicode Lib "USER32" (ByVal hWnd As LongPtr) As Long
#Else
    Private Declare Function DefWindowProc Lib "USER32" Alias "DefWindowProcW" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function IsWindowUnicode Lib "USER32" (ByVal hWnd As Long) As Long
#End If

Private Sub TestSetUniCaption()
#If VBA7 Then
    Dim hWnd As LongPtr
#Else
    Dim hWnd As Long
#End If
    Dim sUnicode As String
   
    hWnd = FindWindow("ThunderDFrame", Caption)  ' Tim HWnd cua UserForm
    MsgBox IsWindowUnicode(hWnd)
   
    sUnicode = "L" & ChrW(7863) & "p l" & ChrW(7841) & "i tiêu " & ChrW(273) & ChrW(7873) & " cho dòng d" & ChrW(7919) & " li" & ChrW(7879) & "u"
    DefWindowProc hWnd, WM_SETTEXT, 0, StrPtr(sUnicode)
End Sub
 
Upvote 0
ThangCuAnh đã viết:
À máy tôi Win7 32, Office 32bit 2007, chạy đoạn code của bác Tuân cũng không ra. Test với hàm API IsWindowUnicode thì ra FALSE (0), tức Ansi Window
Bạn giaiphap dùng Office gì vậy, chạy giúp tôi đoạn code này thử
Mã: 
Private Const WM_SETTEXT = &HC
#If VBA7 Then
    Private Declare PtrSafe Function DefWindowProc Lib "user32" Alias "DefWindowProcW" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function IsWindowUnicode Lib "USER32" (ByVal hWnd As LongPtr) As Long
#Else
    Private Declare Function DefWindowProc Lib "USER32" Alias "DefWindowProcW" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function IsWindowUnicode Lib "USER32" (ByVal hWnd As Long) As Long
#End If

Private Sub TestSetUniCaption()
#If VBA7 Then
    Dim hWnd As LongPtr
#Else
    Dim hWnd As Long
#End If
    Dim sUnicode As String
  
    hWnd = FindWindow("ThunderDFrame", Caption)  ' Tim HWnd cua UserForm
    MsgBox IsWindowUnicode(hWnd)
  
    sUnicode = "L" & ChrW(7863) & "p l" & ChrW(7841) & "i tiêu " & ChrW(273) & ChrW(7873) & " cho dòng d" & ChrW(7919) & " li" & ChrW(7879) & "u"
    DefWindowProc hWnd, WM_SETTEXT, 0, StrPtr(sUnicode)
End Sub
Nhấp chuột vào đây để mở rộng...
Win và Office đều 32bit, kết quả hiển thị tiêu đề Unicode được nhưng hàm IsWindowUnicode kết quả bằng 0.
 
Upvote 0
Lạ ta, Office bạn ver mấy ? VBA bạn là VBA7 hay 6, file fm20.dll trong %Windows%\System32 có version là bao nhiêu ? Xem giúp mình ?
Mình Office2007, VBA6, FM20.dll có ver là 12.0.4518.1014
 
Upvote 0
Bạn debug giúp mình, xem kỹ là DefWindowProcW hay DefWindowProcA, code của bác Tuan đấy
 
Upvote 0
Hi Ad
220086
Hinh 1 là hình em đã đã những khai báo vào Module, kết quả ko báo lỗi nữa
220087
Hình anh là e copy đoạn của ad (dòng đặt tên cho tiêu đề của form) thì bị báo lỗi như vậy
 
Upvote 0
Upvote 0
Phải chỉnh lại vì Office của bạn ấy là 64bit, khai báo hwnd as Long sẽ bị báo lỗi Type mismatch. Phải là LongPtr
Sữa lại thành giống code tui vừa post
Bài đã được tự động gộp:

Code của bác Tuân lúc đầu cả 2 đều là DefWindowProcA
 
Upvote 0
giaiphap đã viết:
Thử đoạn code này của anh @Nguyễn Duy Tuân thử xem được không?
Mã: 
Option Explicit
Private Const WM_SETTEXT = &HC
#If Win64 Then
    Declare PtrSafe Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcW" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) 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 = "L" & ChrW(7863) & "p l" & ChrW(7841) & "i tiêu " & ChrW(273) & ChrW(7873) & " cho dòng d" & ChrW(7919) & " li" & ChrW(7879) & "u"
    DefWindowProc hwnd, WM_SETTEXT, 0, StrPtr(sUnicode)
End Sub
Nhấp chuột vào đây để mở rộng...

Hình như có lỗi thật. Các bạn tìm hiểu tiếp xem? Mình đang ngoài đường nên chưa tìm lại lý do được.
 
Upvote 0
Ở máy tôi 32bit chạy tốt, @ThangCuAnh chạy 64bit thử xem có được không?
 

File đính kèm

  • Caption Unicode.xlsm
    17.3 KB · Đọc: 43
Upvote 0
Không được bạn, mình đã thử rồi mới đăng lên đây. Máy hiện tại tại VP mình đang ngồi là Offcie 2007, 32bit, Win7
Bạn up giúp mình file FM20.dll trong thư mục Windows System32 của bạn nhé. Để tối về mình RE và compare xem sao.
 

File đính kèm

  • 1.png
    1.png
    7.4 KB · Đọc: 22
Upvote 0
ThangCuAnh đã viết:
Không được bạn, mình đã thử rồi mới đăng lên đây. Máy hiện tại tại VP mình đang ngồi là Offcie 2007, 32bit, Win7
Bạn up giúp mình file FM20.dll trong thư mục Windows System32 của bạn nhé. Để tối về mình RE và compare xem sao.
Nhấp chuột vào đây để mở rộng...
File đây bạn.
 

File đính kèm

  • FM20.rar
    446.8 KB · Đọc: 24
Upvote 0
Lạ nhỉ, mình đã thay FM20.dll trên máy mình bằng FM20.dll của bạn, vẫn chạy không ra.
FM20.dll của bạn ver là: 14.0.4747.1000
UserForm hoạt động độc lập với VBA và Office mà ta, không lý còn tầng nào đó mà FM20.dll phải đi qua à ?
 
Upvote 0
ThangCuAnh đã viết:
Lạ nhỉ, mình đã thay FM20.dll trên máy mình bằng FM20.dll của bạn, vẫn chạy không ra.
FM20.dll của bạn ver là: 14.0.4747.1000
UserForm hoạt động độc lập với VBA và Office mà ta, không lý còn tầng nào đó mà FM20.dll phải đi qua à ?
Nhấp chuột vào đây để mở rộng...
Thử test lại file này xem sao.
 

File đính kèm

  • Caption Unicode.xlsm
    18.3 KB · Đọc: 36
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

P
HÀM SUBTOTAL BỊ #VALUE
Trả lời
2
Đọc
44
phantuancauvan
P
phanmoi688
[Xin nhờ giúp đỡ] Cách đối chiếu dữ liệu giữa hai biểu
    • Thích
2
Trả lời
28
Đọc
389
VetMini
V
tby211
Lỗi 1004 vba khi tách file trắc nghiệm sang excel
Trả lời
0
Đọc
23
tby211
tby211
NguyenthiH
  • Question
Code lấy dữ liệu cho sheet!TonDau.
Trả lời
6
Đọc
147
NguyenthiH
NguyenthiH
test1986
  • Question
HELP! Sử dụng combobox để cập nhật dữ liệu trong file Excel
Trả lời
17
Đọc
508
ngochienbmt
N
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom