你好:
請執行 GetPassWord 程序
Option Explicit
''/////////////////////////////////////////////////////////////////
''// 25 May 2003 //
''// Amended Ivan F Moala
''/////////////////////////////////////////////////////////////////
Public Declare Function GetActiveWindow _
Lib "user32" () _
As Long
Public Declare Function FindWindowEx _
Lib "user32" _
Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) _
As Long
Public Declare Function SendMessage _
Lib "user32" _
Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long
Public Declare Function SetTimer _
Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) _
As Long
Public Declare Function KillTimer _
Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long) _
As Long
Public Declare Function GetForegroundWindow _
Lib "user32" () _
As Long
Private Const nIDE As Long = &H100
Private Const EM_SETPASSWORDCHAR = &HCC
Private hdlEditBox As Long
Private Fgrndhdl As Long
'////////////////////////////////////////////////////
'// This is The main routine
'// where we test it
'////////////////////////////////////////////////////
Sub GetPassWord()
Dim x As String
x = InPutBoxPwd("Please enter password", "Sentry")
If x = vbNullString Then
MsgBox "User Cancelled"
Else
MsgBox "User entered " & x
End If
End Sub
Public Function TimerFunc( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal nEvent As Long, _
ByVal nSecs As Long) As Long
Dim hdlwndAct As Long
'// Do we have a handle to the EditBox
If hdlEditBox > 0 Then Exit Function
'// Get the handle to the ActiveWindow
hdlwndAct = GetActiveWindow()
'// Get the Editbox handle
hdlEditBox = FindWindowEx(hdlwndAct, 0, "Edit", "")
'// Set the password character for the InputBox
SendMessage hdlEditBox, EM_SETPASSWORDCHAR, Asc("*"), ByVal 0
End Function
Public Function InPutBoxPwd(fPrompt As String, _
Optional fTitle As String, _
Optional fDefault As String, _
Optional fXpos As Long, _
Optional fYpos As Long, _
Optional fHelpfile As String, _
Optional fContext As Long) As String
Dim sInput As String
'// Initialize
hdlEditBox = 0
Fgrndhdl = GetForegroundWindow
'// Windows-Timer
SetTimer Fgrndhdl, nIDE, 100, AddressOf TimerFunc
'// Main InputBox
If fXpos Then
sInput = InputBox(fPrompt, fTitle, fDefault, fXpos, fYpos,
fHelpfile, fContext)
Else
sInput = InputBox(fPrompt, fTitle, fDefault, , , fHelpfile, fContext)
End If
'// Kill the correct Timer
KillTimer Fgrndhdl, nIDE
'// Pass result
InPutBoxPwd = sInput
End Function
--
天行健君子以自強不息
http://www.vba.com.tw/plog/
"wiepwos" 來函：
Post by wiepwosSorry,我發覺我將問題複雜化了…
剛剛再檢測一次VBA程式才發現是INPUTBOX的問題
即是跳出一個輸入視窗後我KEY入資料
如何才能更改輸入畫面顯示的資料為＊字號，而非明文呢？
"Carson" 來函：
Post by Carson你好！
在文字方塊的屬性裡，有一個叫PasswordChar的屬性，在那裡輸入*就可以。
也就是說要用表單（Form）做你那個對話方塊，不能普通的MsgBox。
Carson
_____________________
Carson Cheng 鄭皓斌
MVP from Hong Kong
Post by wiepwos請問一下
在EXCEL中使用VBA撰寫程式
並設定檔案開啟時會出現對話方塊
並要求輸入密碼作為登入之身份確認
但，我現在所輸入的密碼則會以明碼顯示
而非一般的＊字號顯示，而造成無法保密的狀況！
請問應該增加何者參數？或是VBA本身沒這個功能呢？
敬請指教，謝謝~