Trợ giúp gõ chữ tiếng Việt có dấu trong FORM

[GACON_VBA]

Chào các bác, em cần trợ giúp cách gõ chữ tiếng Việt có dấu trong form dữ liệu. Với em thấy có chèn biểu tượng icoin vào (như kiểu excel) nữa thi hay quá ạ. Mong nhận được sự trợ giúp của các bác. Xin cảm ơn trước ạ!

 

[VuVanHao]

Bạn tham khảo. Nguồn trên diễn đàn

 

[ndu96081631]

Bạn tham khảo. Nguồn trên diễn đàn

Code quá trời đất, ổng coi chắc ổng khùng luôn quá
Vầy thôi đủ rồi:

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcW" _
    (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As LongPtr) As LongPtr

Private Sub UserForm_Initialize()
  Dim hwnd      As LongPtr
  Dim sUniCap   As String
  hwnd = FindWindow("ThunderDFrame", Me.Caption)
  sUniCap = "C" & ChrW(7897) & "ng ḥa xă h" & ChrW(7897) & "i ch" & ChrW(7911) & " ngh" & ChrW(297) & "a Vi" & ChrW(7879) & "t Nam"
  DefWindowProc hwnd, &HC, 0, StrPtr(sUniCap)
End Sub

 

[GACON_VBA]

Bạn tham khảo. Nguồn trên diễn đàn

Cảm ơn bác. Mà em nhìn rối quá. "Tiếng Việt có dấu" là đoạn nào trong đó vậy bác... em thay bằng chữ "Cảm ơn bác nhiều" thì phải thay như thế nào bác chỉ em với ạ...

 

[VuVanHao]

@ndu96081631 . Thường em cứ import module vào file cần, xong nhớ chỗ viết sub trong form thôi ạ. Chứ module kia em nhìn như cũng không hiểu gì hết =))

 

[GACON_VBA]

Code quá trời đất, ổng coi chắc ổng khùng luôn quá
Vầy thôi đủ rồi:

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcW" _
    (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As LongPtr) As LongPtr

Private Sub UserForm_Initialize()
  Dim hwnd      As LongPtr
  Dim sUniCap   As String
  hwnd = FindWindow("ThunderDFrame", Me.Caption)
  sUniCap = "C" & ChrW(7897) & "ng ḥa xă h" & ChrW(7897) & "i ch" & ChrW(7911) & " ngh" & ChrW(297) & "a Vi" & ChrW(7879) & "t Nam"
  DefWindowProc hwnd, &HC, 0, StrPtr(sUniCap)
End Sub

Làm thế nào để chạy code này bác. Em copy dán vào module mới mà k được ạ. Bác hướng dẫn em với...

 

[VuVanHao]

@GACON_VBA Em không hiểu code họ viết gì thì em cứ thêm 2 cái module vào file xong viết code này trong form :v

Private Sub UserForm_Initialize()
    UniCaption Me, UniConvert("Tieesng Vieejt Cos daasu", "Telex")    '--- Go dang telex nhe
End Sub

Bác thay thành:

Private Sub UserForm_Initialize()
    UniCaption Me, UniConvert("Carm Own Basc Nhieefu", "Telex")    '--- Go dang telex nhe
End Sub

 

[ndu96081631]

Làm thế nào để chạy code này bác. Em copy dán vào module mới mà k được ạ. Bác hướng dẫn em với...

Toàn bộ code để hiện tiếng Việt và chèn Icon (trong UserForm chứ không phải trong Module)

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcW" _
    (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" _
    (ByVal hInst As LongPtr, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
Private Const WM_SETTEXT = &HC
Private hWnd    As LongPtr

Private Sub SetIcon(ByVal hWnd As LongPtr, ByVal strIconPath As String)
  Dim hIcon As LongPtr
  Dim lRet  As LongPtr
  hIcon = ExtractIcon(0, strIconPath, 0)
  lRet = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
  lRet = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
End Sub
Private Sub SetUniCap(ByVal hWnd As LongPtr, ByVal sUniCap As String)
  Dim lProc As LongPtr
  lProc = DefWindowProc(hWnd, WM_SETTEXT, 0, StrPtr(sUniCap))
End Sub
Private Sub UserForm_Initialize()
  Dim sUniCap       As String
  Dim strIconPath   As String
  hWnd = FindWindow("ThunderDFrame", Me.Caption)
 
  sUniCap = "C" & ChrW(7897) & "ng hòa xã h" & ChrW(7897) & "i ch" & ChrW(7911) & " ngh" & ChrW(297) & "a Vi" & ChrW(7879) & "t Nam"
  SetUniCap hWnd, sUniCap
 
  strIconPath = ThisWorkbook.Path & "\bing.ico"
  SetIcon hWnd, strIconPath
End Sub

Biến sUniCap chính là chỗ tiếng Việt đó
Code này ngắn gọn nhất (có thể) rồi đó
Lưu ý: phải giải nén file trước nha (chạy luôn trong file RAR sẽ thiếu icon)

 

[GACON_VBA]

Toàn bộ code để hiện tiếng Việt và chèn Icon (trong UserForm chứ không phải trong Module)

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcW" _
    (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" _
    (ByVal hInst As LongPtr, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
Private Const WM_SETTEXT = &HC
Private hWnd    As LongPtr

Private Sub SetIcon(ByVal hWnd As LongPtr, ByVal strIconPath As String)
  Dim hIcon As LongPtr
  Dim lRet  As LongPtr
  hIcon = ExtractIcon(0, strIconPath, 0)
  lRet = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
  lRet = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
End Sub
Private Sub SetUniCap(ByVal hWnd As LongPtr, ByVal sUniCap As String)
  Dim lProc As LongPtr
  lProc = DefWindowProc(hWnd, WM_SETTEXT, 0, StrPtr(sUniCap))
End Sub
Private Sub UserForm_Initialize()
  Dim sUniCap       As String
  Dim strIconPath   As String
  hWnd = FindWindow("ThunderDFrame", Me.Caption)

  sUniCap = "C" & ChrW(7897) & "ng hòa xã h" & ChrW(7897) & "i ch" & ChrW(7911) & " ngh" & ChrW(297) & "a Vi" & ChrW(7879) & "t Nam"
  SetUniCap hWnd, sUniCap

  strIconPath = ThisWorkbook.Path & "\bing.ico"
  SetIcon hWnd, strIconPath
End Sub

Biến sUniCap chính là chỗ tiếng Việt đó
Code này ngắn gọn nhất (có thể) rồi đó
Lưu ý: phải giải nén file trước nha (chạy luôn trong file RAR sẽ thiếu icon)

Em làm được rồi ạ. Hơi tham lam chút, bác có cách nào dấu Icoin vào ổ C mục cài đặt excel ofilce (ổ C:\....) hay tân dụng icoin có sẳn trong đó không ạ. Tại có Icoin đi kèm trong nó cồng kềnh chút. hihhi

 

[ndu96081631]

Em làm được rồi ạ. Hơi tham lam chút, bác có cách nào dấu Icoin vào ổ C mục cài đặt excel ofilce (ổ C:\....) hay tân dụng icoin có sẳn trong đó không ạ. Tại có Icoin đi kèm trong nó cồng kềnh chút. hihhi

Thì bạn muốn nhét icon ở đâu cũng được mà, chỉ cần khai báo đường dẫn chính xác là được rồi. Thay đường dẫn đến file icon chỗ này:

strIconPath = ThisWorkbook.Path & "\bing.ico"