Code nhập password chạy VBA

Namnuns2

Thành viên mới
Tham gia ngày
21 Tháng mười một 2020
Bài viết
18
Được thích
0
Điểm
13
Tuổi
25
Xin chỉ giáo. Mình muốn tạo đoạn Code yêu cầu khi kick vào biểu tượng để chạy VBA thì hiện yêu cầu nhập đúng pass thì mới thực hiện chạy VBA. TKS
 

lmtuyen

Thành viên chính thức
Tham gia ngày
14 Tháng ba 2009
Bài viết
57
Được thích
9
Điểm
670
bạn vào link trên xem thử, tùy biến lại cho phù hợp
 

Namnuns2

Thành viên mới
Tham gia ngày
21 Tháng mười một 2020
Bài viết
18
Được thích
0
Điểm
13
Tuổi
25
bạn vào link trên xem thử, tùy biến lại cho phù hợp
Tks bạn. Đây là tạo user và pass đăng nhập để mở file. Mình thì muốn là lúc bấm run để chạy VBA thì nó hiện pass ấy. Đang mò mẩm xem có cách nào ko
 

lmtuyen

Thành viên chính thức
Tham gia ngày
14 Tháng ba 2009
Bài viết
57
Được thích
9
Điểm
670
làm đơn giản hen, không cần userform làm gì thì tạm xài inputbox vậy

Sub askpass()
Dim myvalue As Variant
myvalue = Application.InputBox(" Pls Enter Pass")
If myvalue = "Admin" Then
MsgBox " chuc mung ban"
Else
MsgBox " Sai Pass"
End If

End Sub
 

File đính kèm

Namnuns2

Thành viên mới
Tham gia ngày
21 Tháng mười một 2020
Bài viết
18
Được thích
0
Điểm
13
Tuổi
25
làm đơn giản hen, không cần userform làm gì thì tạm xài inputbox vậy

Sub askpass()
Dim myvalue As Variant
myvalue = Application.InputBox(" Pls Enter Pass")
If myvalue = "Admin" Then
MsgBox " chuc mung ban"
Else
MsgBox " Sai Pass"
End If

End Sub
Tks bạn nhiều. Đúng ý mình muốn luôn
 

Namnuns2

Thành viên mới
Tham gia ngày
21 Tháng mười một 2020
Bài viết
18
Được thích
0
Điểm
13
Tuổi
25
làm đơn giản hen, không cần userform làm gì thì tạm xài inputbox vậy

Sub askpass()
Dim myvalue As Variant
myvalue = Application.InputBox(" Pls Enter Pass")
If myvalue = "Admin" Then
MsgBox " chuc mung ban"
Else
MsgBox " Sai Pass"
End If

End Sub
Lúc hiển thị bảng nhập pass word. Mình nhập pass vào thì nó hiển thị pass. Có cách nào để nó hiện là . để người khác ko thấy được ko Bạn. Tks
 

Namnuns2

Thành viên mới
Tham gia ngày
21 Tháng mười một 2020
Bài viết
18
Được thích
0
Điểm
13
Tuổi
25
bạn chịu khó lên google search tí ra nhiều cái hay lắm.
Bạn có link bài viết nào về vấn đê này ko cho mình xin với. Minh search thì toàn bài kiểu làm form đăng nhập. xong dùng "chọn Textbox và vào properties / PasswordChar bạn nhập vào "*" " thôi ah
 

batman1

Thành viên gạo cội
Tham gia ngày
8 Tháng chín 2014
Bài viết
3,673
Được thích
5,676
Điểm
560
Bạn có link bài viết nào về vấn đê này ko cho mình xin với. Minh search thì toàn bài kiểu làm form đăng nhập. xong dùng "chọn Textbox và vào properties / PasswordChar bạn nhập vào "*" " thôi ah
Thế form đăng nhập không được à? Tại sao cứ phải InputBox?
 

batman1

Thành viên gạo cội
Tham gia ngày
8 Tháng chín 2014
Bài viết
3,673
Được thích
5,676
Điểm
560
Lưu ỵ́:
Đã sửa
Mã:
HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.Hinstance, GetCurrentThreadId)
thành
Mã:
#If VBA7 Then
        HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.HinstancePtr, GetCurrentThreadId)
#Else
        HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.Hinstance, GetCurrentThreadId)
#End If
--------------
Nếu cố tình muốn dùng InputBox thì ...

Lưu ý:
- Tôi viết xong chỉ thử trên Windows 10 64 bit + Excel 2013 32 bit. Tôi không đảm bảo là code sẽ chạy trên mọi phiên bản Excel.
- InputBoxUnicode không chỉ phục vụ "*" mà còn phục vụ tiêu đề và dòng nhắc bằng tiếng Việt.

Thao tác:
1. Mở Excel -> Alt + F11 -> menu Insert -> Module -> đổi tên Module1 thành modInputBox -> trong modInputBox nhập code tôi cung cấp ở dưới -> menu File -> Export File ... -> lưu lại với tên InputBox.bas ở một thư mục nào đó, vd. thư mục "Thư viện".

2. Sau này mỗi khi cần dùng InputBox với tiêu đề và dòng nhắc tiếng Việt và/hoặc nhập "*" trong trường nhập thì thực hiện thao tác: mở tập tin cần dùng InputBox -> Alt + F11 -> menu File -> Import File -> duyệt tới thư mục "Thư viện" -> chọn modInputBox.bas -> ở đâu đó trong code gọi hàm InputBoxUnicode. Ở dưới tôi cho ví dụ sub test gọi hàm InputBoxUnicode.

Code ví dụ gọi hàm InputBoxUnicode
Mã:
Sub test()
Dim matkhau As String, title As String, prompt As String
    title = "Nh" & ChrW(7853) & "p m" & ChrW(7853) & "t kh" & ChrW(7849) & "u"
    prompt = "H" & ChrW(227) & "y nh" & ChrW(7853) & "p m" & ChrW(7853) & "t kh" & ChrW(7849) & "u " & ChrW(273) & ChrW(7875) & " ti" & ChrW(7871) & "p t" & ChrW(7909) & "c"
    matkhau = InputBoxUnicode(prompt, title, True, "hic hic")
    If matkhau <> "hic hic he he he" Then
        MsgBox "Khong biet mat khau thi dung hong di tiep nhe"
        Exit Sub
    End If
'    các code tiếp theo
End Sub
Code trong modInputBox
Mã:
Option Explicit
'    Tác giả: siwtom - batman1

Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE As Long = 5

Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WM_SETTEXT = &HC

#If VBA7 Then
    Private Declare PtrSafe Function DefWindowProcW Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    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 Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
#Else
    Private Declare Function DefWindowProcW Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32.dll" () As Long
#End If

#If VBA7 Then
    Private HookHandle As LongPtr
#Else
    Private HookHandle As Long
#End If

Private sPrompt As String, sTitle As String, ShowPasswordChar As Boolean

#If VBA7 Then
    Private Function CBTProc(ByVal code As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Dim hStatic As LongPtr, hEdit As LongPtr
#Else
    Private Function CBTProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim hStatic As Long, hEdit As Long
#End If

Dim sClass As String, length As Long
    If code = HCBT_ACTIVATE Then
        sClass = String(255, Chr(0))
        length = GetClassName(wParam, sClass, 255)
        sClass = Left(sClass, length)
        If sClass = "#32770" Then
            hStatic = FindWindowEx(wParam, 0, "Static", vbNullString)
            hEdit = FindWindowEx(wParam, 0, "Edit", vbNullString)
            If Len(sTitle) Then DefWindowProcW wParam, WM_SETTEXT, 0, StrPtr(sTitle)
            If Len(sPrompt) Then DefWindowProcW hStatic, WM_SETTEXT, 0, StrPtr(sPrompt)
            If ShowPasswordChar Then SendMessage hEdit, EM_SETPASSWORDCHAR, Asc("*"), 0
        End If
    End If
   
    CBTProc = CallNextHookEx(HookHandle, code, wParam, lParam)
End Function

Function InputBoxUnicode(ByVal prompt As String, Optional ByVal title As String, _
                    Optional ByVal PasswordChar As Boolean = False, _
                    Optional ByVal default As String, Optional ByVal xpos As Variant, Optional ByVal ypos As Variant, _
                    Optional HelpFile As String, Optional ByVal Context As Long) As String
'    PasswordChar = False -> nhìn thấy dữ liệu nhập
'    PasswordChar = True -> các ký tự nhập biến thành "*"
    sPrompt = prompt
    sTitle = title
    ShowPasswordChar = PasswordChar
    
#If VBA7 Then
        HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.HinstancePtr, GetCurrentThreadId)
#Else
        HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.Hinstance, GetCurrentThreadId)
#End If
    InputBoxUnicode = VBA.InputBox(prompt, title, default, xpos, ypos, HelpFile, Context)
    UnhookWindowsHookEx (HookHandle)
End Function
 
Lần chỉnh sửa cuối:

Namnuns2

Thành viên mới
Tham gia ngày
21 Tháng mười một 2020
Bài viết
18
Được thích
0
Điểm
13
Tuổi
25
Nếu cố tình muốn dùng InputBox thì ...

Lưu ý:
- Tôi viết xong chỉ thử trên Windows 10 64 bit + Excel 2013 32 bit. Tôi không đảm bảo là code sẽ chạy trên mọi phiên bản Excel.
- InputBoxUnicode không chỉ phục vụ "*" mà còn phục vụ tiêu đề và dòng nhắc bằng tiếng Việt.

Thao tác:
1. Mở Excel -> Alt + F11 -> menu Insert -> Module -> đổi tên Module1 thành modInputBox -> trong modInputBox nhập code tôi cung cấp ở dưới -> menu File -> Export File ... -> lưu lại với tên InputBox.bas ở một thư mục nào đó, vd. thư mục "Thư viện".

2. Sau này mỗi khi cần dùng InputBox với tiêu đề và dòng nhắc tiếng Việt và/hoặc nhập "*" trong trường nhập thì thực hiện thao tác: mở tập tin cần dùng InputBox -> Alt + F11 -> menu File -> Import File -> duyệt tới thư mục "Thư viện" -> chọn modInputBox.bas -> ở đâu đó trong code gọi hàm InputBoxUnicode. Ở dưới tôi cho ví dụ sub test gọi hàm InputBoxUnicode.

Code ví dụ gọi hàm InputBoxUnicode
Mã:
Sub test()
Dim matkhau As String, title As String, prompt As String
    title = "Nh" & ChrW(7853) & "p m" & ChrW(7853) & "t kh" & ChrW(7849) & "u"
    prompt = "H" & ChrW(227) & "y nh" & ChrW(7853) & "p m" & ChrW(7853) & "t kh" & ChrW(7849) & "u " & ChrW(273) & ChrW(7875) & " ti" & ChrW(7871) & "p t" & ChrW(7909) & "c"
    matkhau = InputBoxUnicode(prompt, title, True, "hic hic")
    If matkhau <> "hic hic he he he" Then
        MsgBox "Khong biet mat khau thi dung hong di tiep nhe"
        Exit Sub
    End If
'    các code tiếp theo
End Sub
Code trong modInputBox
Mã:
Option Explicit
'    Tác giả: siwtom - batman1

Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE As Long = 5

Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WM_SETTEXT = &HC

#If VBA7 Then
    Private Declare PtrSafe Function DefWindowProcW Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    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 Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
#Else
    Private Declare Function DefWindowProcW Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32.dll" () As Long
#End If

#If VBA7 Then
    Private HookHandle As LongPtr
#Else
    Private HookHandle As Long
#End If

Private sPrompt As String, sTitle As String, ShowPasswordChar As Boolean

#If VBA7 Then
    Private Function CBTProc(ByVal code As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Dim hStatic As LongPtr, hEdit As LongPtr
#Else
    Private Function CBTProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim hStatic As Long, hEdit As Long
#End If

Dim sClass As String, length As Long
    If code = HCBT_ACTIVATE Then
        sClass = String(255, Chr(0))
        length = GetClassName(wParam, sClass, 255)
        sClass = Left(sClass, length)
        If sClass = "#32770" Then
            hStatic = FindWindowEx(wParam, 0, "Static", vbNullString)
            hEdit = FindWindowEx(wParam, 0, "Edit", vbNullString)
            If Len(sTitle) Then DefWindowProcW wParam, WM_SETTEXT, 0, StrPtr(sTitle)
            If Len(sPrompt) Then DefWindowProcW hStatic, WM_SETTEXT, 0, StrPtr(sPrompt)
            If ShowPasswordChar Then SendMessage hEdit, EM_SETPASSWORDCHAR, Asc("*"), 0
        End If
    End If
   
    CBTProc = CallNextHookEx(HookHandle, code, wParam, lParam)
End Function

Function InputBoxUnicode(ByVal prompt As String, Optional ByVal title As String, _
                    Optional ByVal PasswordChar As Boolean = False, _
                    Optional ByVal default As String, Optional ByVal xpos As Variant, Optional ByVal ypos As Variant, _
                    Optional HelpFile As String, Optional ByVal Context As Long) As String
'    PasswordChar = False -> nhìn thấy dữ liệu nhập
'    PasswordChar = True -> các ký tự nhập biến thành "*"
    sPrompt = prompt
    sTitle = title
    ShowPasswordChar = PasswordChar
    HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.Hinstance, GetCurrentThreadId)
    InputBoxUnicode = VBA.InputBox(prompt, title, default, xpos, ypos, HelpFile, Context)
    UnhookWindowsHookEx (HookHandle)
End Function
Cảm ơn bác nhiều <3<3
Bài đã được tự động gộp:

Tks Bác nha
 

Namnuns2

Thành viên mới
Tham gia ngày
21 Tháng mười một 2020
Bài viết
18
Được thích
0
Điểm
13
Tuổi
25
Nếu cố tình muốn dùng InputBox thì ...

Lưu ý:
- Tôi viết xong chỉ thử trên Windows 10 64 bit + Excel 2013 32 bit. Tôi không đảm bảo là code sẽ chạy trên mọi phiên bản Excel.
- InputBoxUnicode không chỉ phục vụ "*" mà còn phục vụ tiêu đề và dòng nhắc bằng tiếng Việt.

Thao tác:
1. Mở Excel -> Alt + F11 -> menu Insert -> Module -> đổi tên Module1 thành modInputBox -> trong modInputBox nhập code tôi cung cấp ở dưới -> menu File -> Export File ... -> lưu lại với tên InputBox.bas ở một thư mục nào đó, vd. thư mục "Thư viện".

2. Sau này mỗi khi cần dùng InputBox với tiêu đề và dòng nhắc tiếng Việt và/hoặc nhập "*" trong trường nhập thì thực hiện thao tác: mở tập tin cần dùng InputBox -> Alt + F11 -> menu File -> Import File -> duyệt tới thư mục "Thư viện" -> chọn modInputBox.bas -> ở đâu đó trong code gọi hàm InputBoxUnicode. Ở dưới tôi cho ví dụ sub test gọi hàm InputBoxUnicode.

Code ví dụ gọi hàm InputBoxUnicode
Mã:
Sub test()
Dim matkhau As String, title As String, prompt As String
    title = "Nh" & ChrW(7853) & "p m" & ChrW(7853) & "t kh" & ChrW(7849) & "u"
    prompt = "H" & ChrW(227) & "y nh" & ChrW(7853) & "p m" & ChrW(7853) & "t kh" & ChrW(7849) & "u " & ChrW(273) & ChrW(7875) & " ti" & ChrW(7871) & "p t" & ChrW(7909) & "c"
    matkhau = InputBoxUnicode(prompt, title, True, "hic hic")
    If matkhau <> "hic hic he he he" Then
        MsgBox "Khong biet mat khau thi dung hong di tiep nhe"
        Exit Sub
    End If
'    các code tiếp theo
End Sub
Code trong modInputBox
Mã:
Option Explicit
'    Tác giả: siwtom - batman1

Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE As Long = 5

Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WM_SETTEXT = &HC

#If VBA7 Then
    Private Declare PtrSafe Function DefWindowProcW Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    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 Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
#Else
    Private Declare Function DefWindowProcW Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32.dll" () As Long
#End If

#If VBA7 Then
    Private HookHandle As LongPtr
#Else
    Private HookHandle As Long
#End If

Private sPrompt As String, sTitle As String, ShowPasswordChar As Boolean

#If VBA7 Then
    Private Function CBTProc(ByVal code As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Dim hStatic As LongPtr, hEdit As LongPtr
#Else
    Private Function CBTProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim hStatic As Long, hEdit As Long
#End If

Dim sClass As String, length As Long
    If code = HCBT_ACTIVATE Then
        sClass = String(255, Chr(0))
        length = GetClassName(wParam, sClass, 255)
        sClass = Left(sClass, length)
        If sClass = "#32770" Then
            hStatic = FindWindowEx(wParam, 0, "Static", vbNullString)
            hEdit = FindWindowEx(wParam, 0, "Edit", vbNullString)
            If Len(sTitle) Then DefWindowProcW wParam, WM_SETTEXT, 0, StrPtr(sTitle)
            If Len(sPrompt) Then DefWindowProcW hStatic, WM_SETTEXT, 0, StrPtr(sPrompt)
            If ShowPasswordChar Then SendMessage hEdit, EM_SETPASSWORDCHAR, Asc("*"), 0
        End If
    End If
   
    CBTProc = CallNextHookEx(HookHandle, code, wParam, lParam)
End Function

Function InputBoxUnicode(ByVal prompt As String, Optional ByVal title As String, _
                    Optional ByVal PasswordChar As Boolean = False, _
                    Optional ByVal default As String, Optional ByVal xpos As Variant, Optional ByVal ypos As Variant, _
                    Optional HelpFile As String, Optional ByVal Context As Long) As String
'    PasswordChar = False -> nhìn thấy dữ liệu nhập
'    PasswordChar = True -> các ký tự nhập biến thành "*"
    sPrompt = prompt
    sTitle = title
    ShowPasswordChar = PasswordChar
    HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.Hinstance, GetCurrentThreadId)
    InputBoxUnicode = VBA.InputBox(prompt, title, default, xpos, ypos, HelpFile, Context)
    UnhookWindowsHookEx (HookHandle)
End Function
Mình đã là theo các hướng dẫn của bạn. nhưng lúc chạy nó báo lỗi. Mình mới bắt đầu học VBA nên ko biết fix như thế nào. Bác giúp với


1606012199178.png 1606012220306.png1606012199178.png1606012220306.png
 

NHN_Phương

Thành viên tích cực
Tham gia ngày
5 Tháng mười một 2015
Bài viết
1,278
Được thích
542
Điểm
560
Nơi ở
Hà Nội
Mình đã là theo các hướng dẫn của bạn. nhưng lúc chạy nó báo lỗi. Mình mới bắt đầu học VBA nên ko biết fix như thế nào. Bác giúp với


View attachment 249801 View attachment 249802View attachment 249801View attachment 249802
Trước đây OT gặp lỗi này và đã được bác Siwtom chỉ dẫn,bạn thử sửa lại như sau xem được không ạ:
Trong Function InputBoxUnicode, thay dòng:
Mã:
HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.Hinstance, GetCurrentThreadId)
thành đoạn:
Mã:
    #If VBA7 Then
        HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.HinstancePtr, GetCurrentThreadId)
    #Else
        HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.Hinstance, GetCurrentThreadId)
    #End If
 

Namnuns2

Thành viên mới
Tham gia ngày
21 Tháng mười một 2020
Bài viết
18
Được thích
0
Điểm
13
Tuổi
25
Trước đây OT gặp lỗi này và đã được bác Siwtom chỉ dẫn,bạn thử sửa lại như sau xem được không ạ:
Trong Function InputBoxUnicode, thay dòng:
Mã:
HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.Hinstance, GetCurrentThreadId)
thành đoạn:
Mã:
    #If VBA7 Then
        HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.HinstancePtr, GetCurrentThreadId)
    #Else
        HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.Hinstance, GetCurrentThreadId)
    #End If
Cảm ơn bạn. Mình đã sửa được rồi.
 

batman1

Thành viên gạo cội
Tham gia ngày
8 Tháng chín 2014
Bài viết
3,673
Được thích
5,676
Điểm
560
Trước đây OT gặp lỗi này và đã được bác Siwtom chỉ dẫn,bạn thử sửa lại như sau xem được không ạ:
Trong Function InputBoxUnicode, thay dòng:
Mã:
HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.Hinstance, GetCurrentThreadId)
thành đoạn:
Mã:
    #If VBA7 Then
        HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.HinstancePtr, GetCurrentThreadId)
    #Else
        HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.Hinstance, GetCurrentThreadId)
    #End If
Cám ơn bạn. Tôi viết xong cũng quên luôn không sửa. Già rồi, nói trước quên sau. :D
 
Top Bottom