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,999
  • UniVba.zip
    7.7 KB · Đọc: 3,275
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: 45
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: 24
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: 37
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

pingping2288
Lỗi cứ lần mở lại file excel là font chữ và định dạng ô lại thay đổi
Trả lời
8
Đọc
78
Hoàng Tuấn 868
H
vova2209
  • Question
Tìm địa chỉ ô với 2đk và chuyển thành links
Trả lời
13
Đọc
219
curet
C
H
  • Question
Xóa toàn bộ các dòng giống nhau ở 1 cột
    • Cười
Trả lời
12
Đọc
93
hadoan-pap
H
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
7 8 9
Trả lời
164
Đọc
8K
chstbcaolanh
C
T
Đánh Số Thứ Tự Loại Bỏ Trùng
Trả lời
1
Đọc
27
bebo021999
B
H
Có thể mở file Excel mới sẽ Zoom mặc định 150% không?
Trả lời
4
Đọc
161
VetMini
V
O
  • Question
Tìm số thứ tự của sheet trong workbook có nhiều sheets
Trả lời
11
Đọc
3K
VetMini
V
Manhhung90
Liệt kê các ngày cộng dồn mong muốn vào 1 ô. Nhờ mọi người giúp mình ạ.
2 3 4
Trả lời
62
Đọc
746
VetMini
V
C
Hàm đánh số thứ tự như không đánh dữ liệu trùng
Trả lời
7
Đọc
8K
Trang Tuyet Ngoc Nhi
T
Hai Lúa Miền Tây
  • Question
Hàm chuyển dữ liệu từ cột sang dòng (Hàm melt + wide_to_long của Python trong Excel)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
468
tranhungdao12a3
T
GPE-Trợ Lý
Đăng ký tham dự hội thảo tại Hà Nội: Power Query - Công cụ quản lý dữ liệu
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
4
Đọc
468
PhanTuHuong
PhanTuHuong
tvcneo
  • Question
Nhờ Anh Chị Em giúp mình cách để tạo macro giống như trong file này
Trả lời
17
Đọc
226
huuthang_bd
huuthang_bd
T
Có phải lỗi Excel?
Trả lời
8
Đọc
9K
dinhthang8709
D
T
Công thức lấy dữ liệu
Trả lời
3
Đọc
122
HUONGHCKT
H
S
  • Question
Nhờ anh chị giúp em hàm ngẫu nhiên với tổng là 1 số
Trả lời
6
Đọc
150
SA_DQ
SA_DQ
L
Tự động nhảy số tham chiếu khi sang sheet mới
Trả lời
5
Đọc
5K
Romantic92
R
TieuLong2708
Danh sách lịch cắt người trực
Trả lời
0
Đọc
38
TieuLong2708
TieuLong2708
C
  • Question
Xin giúp đỡ Code kiểm tra và copy dữ liệu từ sheet 1 sang sheet 2
2
Trả lời
21
Đọc
628
conan1
C
H
  • Question
Mong giúp code chuyển file xls sang xlsx hàng loạt và không lỗi số liệu
Trả lời
16
Đọc
374
Hoàng Tuấn 868
H
jenny12345
tổng hợp dữ liệu theo tháng
Trả lời
10
Đọc
250
Hoàng Tuấn 868
H
Xem thêm…

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