Code nhập password chạy VBA

Liên hệ QC
N

Namnuns2

Thành viên mới
Tham gia
21/11/20
Bài viết
25
Được thích
0
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
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
www.giaiphapexcel.com

Tạo form đăng nhập trong Excel

Chào các bạn! Mình có làm một bài Excel tạo form đăng nhập nhưng mình chưa tạo được form thay đổi thông tin đăng nhập khi đăng nhập đúng. Do đó, khi muốn thay đổi phải mở Vba lên để mà thay đổi trong đó. Rất là phiền phức. Bạn nào biết thì chỉ dùm nhe. Tải file đính kèm xem thử nhe! Xin cám ơn...
www.giaiphapexcel.com www.giaiphapexcel.com
bạn vào link trên xem thử, tùy biến lại cho phù hợp
 
Upvote 0
lmtuyen đã viết:
www.giaiphapexcel.com

Tạo form đăng nhập trong Excel

Chào các bạn! Mình có làm một bài Excel tạo form đăng nhập nhưng mình chưa tạo được form thay đổi thông tin đăng nhập khi đăng nhập đúng. Do đó, khi muốn thay đổi phải mở Vba lên để mà thay đổi trong đó. Rất là phiền phức. Bạn nào biết thì chỉ dùm nhe. Tải file đính kèm xem thử nhe! Xin cám ơn...
www.giaiphapexcel.com www.giaiphapexcel.com
bạn vào link trên xem thử, tùy biến lại cho phù hợp
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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

  • Inputbox.xlsm
    14.4 KB · Đọc: 25
Upvote 0
lmtuyen đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
Namnuns2 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Thế form đăng nhập không được à? Tại sao cứ phải InputBox?
 
Upvote 0
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:
Upvote 0
batman1 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác nhiều <3<3
Bài đã được tự động gộp:

Cu Tồ đã viết:
. Đây
Nhấp chuột vào đây để mở rộng...
Tks Bác nha
 
Upvote 0
batman1 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
Namnuns2 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
NHN_Phương đã viết:
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
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn. Mình đã sửa được rồi.
 
Upvote 0
NHN_Phương đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
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

ongke0711
  • Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
11 12 13
Trả lời
257
Đọc
25K
Pham Ha 233
Pham Ha 233
dung09031989
Xin giúp công thức tô màu các ô phía sau khi kế hoạch đặt hàng thiếu so với tồn kho.?
Trả lời
2
Đọc
97
dung09031989
dung09031989
C
Công thức tự nhập liệu số lượng nhập khi bị âm
Trả lời
2
Đọc
103
cherry0187
C
N
Vẽ biểu đồ kết hợp nhiều yếu tố trong excel
Trả lời
4
Đọc
112
Ny Ny 2024
N
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
17
Đọc
314
phutdm
P
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
11 12 13
Trả lời
251
Đọc
13K
ongke0711
ongke0711
N
Định mức nguyên vật liệu
Trả lời
1
Đọc
154
yeudoi
yeudoi
P
Nhờ giúp đỡ hàm lọc dữ liệu theo tỉnh
Trả lời
7
Đọc
76
Parabol
P
GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
Trả lời
1
Đọc
294
PhanTuHuong
PhanTuHuong
20050911
File Excel lỗi ''The file could not be accessed. Try one of the following:.."
Trả lời
3
Đọc
124
20050911
20050911
B
Định dạng condition formatting, đếm hỗn hợp dữ liệu merge và không merge
Trả lời
17
Đọc
199
batista911
B
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
2
Trả lời
30
Đọc
698
huuthang_bd
huuthang_bd
H
Tính và sắp xếp theo thư tự tăng dần có điều kiệu (có dữ liệu trùng nhau)
Trả lời
1
Đọc
34
bebo021999
B
V
  • Question
Lấy dữ liệu lãi suất từ website Sbv.gov.vn bằng Power Query
Trả lời
1
Đọc
515
Minhhanhsgu
M
Nguyễn Duy Tuân
  • Question
Chia sẻ ControlForOffice - Bộ công cụ điều khiển Office/Excel
    • Thích
6 7 8
Trả lời
149
Đọc
95K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
B
Lọc dữ liệu trùng, đếm số lần, tự tô màu theo điều kiện.
Trả lời
5
Đọc
148
batista911
B
C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
Trả lời
9
Đọc
283
ptm0412
ptm0412
T
Tối ưu hóa hàm lấy dữ liệu từ bảng Tổng sang bảng chi tiết
Trả lời
7
Đọc
245
Hoàng Tuấn 868
H
nguyenphuochien166
Cách Vlookup hoặc cách lấy thông tin dữ liệu có dấu mũ lũy thừa?
    • Cười
Trả lời
6
Đọc
127
tigertiger
tigertiger
T
Không đếm dữ liệu rỗng trong PivotTable
Trả lời
8
Đọc
1K
hoangtuaotrang_hp_vn
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