
エクセルのInputboxで、入力された文字列を自動的にアスタリスクで隠すようにする方法を探し
http://oshiete.goo.ne.jp/qa/2371878.html
の回答No1のコードがまさに最適なコードで、これまで非常に助かっていました。
ところが、64bitのエクセルでは動かないことがわかりました。
表示されたエラーメッセージの言葉から調べて、PtrSafeという言葉を入れなければならないようなのでAPI宣言を以下のようにしてみました。
#If VBA7 And Win64 Then '64ビット版
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare PtrSafe 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 PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
#Else '32ビット版
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 GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) 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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam 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 GetCurrentThreadId Lib "kernel32" () As Long
#End If
ところが、回答No1のコードで
Sub Report_Open() を実行すると
Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
Optional YPos, Optional HelpFile, Optional Context) As String
のところがハイライトされてエラーになります。
どう直せば良いのでしょうか?
全文のコードを乗せると字数制限に引っかかりますので、申し訳ありませんが宣言以外の部分は
http://oshiete.goo.ne.jp/qa/2371878.html
の回答No1のコードを見てくださいますようお願いします。
No.1ベストアンサー
- 回答日時:
(1/2)
こんにちは。
暫く回答お休み中で、質問を読むこともないこの頃なのですが、
たまたま馴染みのアバターをお見かけしましたので、このご質問だけレスしてみます。
Win32 API コールバック、と、64|32bit環境互換については
今の時点での情報が少な過ぎてこちらも確信を持てるものは書けません。
必要な手当てをして、動作確認はしましたが、もっとスマートなやり方があるかも知れません。
お求めに寄り添った直接的な回答として、2回の投稿で記述を掲げますが、
そもそもの方法として、これが唯一のものではないことを知っておいてください。
リンクを張られた質問スレ(元スレ)においては、
「恐らくAccess VBAついての質問であろう」とう前提で回答が付いています。
今回は、Excel カテゴリに書かれた質問ですから、
PasswordCharプロパティを * に設定したTextBoxを配置したユーザーフォーム
(他にPromptを表示するLabel、OKボタンにあたるCommandButton)を用意しておいて、
' ' 標準モジュール
Public rtn
Sub Report_Open()
UserForm1.Show vbModal
If rtn <> "password" Then
MsgBox "社員コードが間違っています。"
End If
End Sub
' ' ユーザーフォームモジュール
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
rtn = TextBox1
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
のようなものを奨めるのがExcel VBA的には本筋だと考えています。
この場合はバージョン互換を意識する必要はありませんし、デザインが自在ですし、
何よりシンプルです。
本題に戻って、、、
AddressOf演算子に渡すFunctionの型は明示的である必要があります。
64bitでは
Function NewProc(...) As LongPtr
32bitでは
Function NewProc(...) As Long
なので、各関数を丸ごと条件付きコンパイルの内側で書き分けてあげる必要があります。
もしも仮に32bit互換を捨てて、64bit環境に限った話としては、
64bit用のDeclare文のすべてと、
各Functionの戻り型、引数、変数について、
Long型の宣言をLongPtr型に(今回必要な記述に関してのみ)
ご提示の記述から全置換すれば期待の動作にはなります。
64bit版については、明らかにLongLong型である場合でも、
LongPtr型で統一して解り易い(編集し易い)ように書いています。
以下、お求めの記述。
' ' ///
Option Explicit
'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
#If VBA7 And Win64 Then '〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
' ' 〓〓〓〓〓64ビット版、以下〓〓〓〓〓
Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
ByVal hHook As LongPtr, ByVal ncode As LongPtr, _
ByVal wParam As LongPtr, lParam As Any _
) As LongPtr
Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" ( _
ByVal lpModuleName As String _
) As LongPtr
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" ( _
ByVal idHook As LongPtr, ByVal lpfn As LongPtr, _
ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr _
) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As LongPtr _
) As LongPtr
Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" ( _
ByVal hDlg As LongPtr, ByVal nIDDlgItem As LongPtr, _
ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr _
) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr _
) As LongPtr
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr
Private Const VER64BIT = True
Private hHook As LongPtr
Private Function NewProc(ByVal lngCode As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Dim strClassName As String
Dim RetVal As LongPtr
Dim lngBuffer As LongPtr
If lngCode < HC_ACTION Then
NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
Exit Function
End If
strClassName = String$(256, " ")
lngBuffer = 255
If lngCode = HCBT_ACTIVATE Then 'A window has been activated
RetVal = GetClassName(wParam, strClassName, lngBuffer)
If Left$(strClassName, CLng(RetVal)) = "#32770" Then 'Class name of the Inputbox
'This changes the edit control so that it display the password character *.
'You can change the Asc("*") as you please.
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
End If
End If
'This line will ensure that any other hooks that may be in place are
'called correctly.
CallNextHookEx hHook, lngCode, wParam, lParam
End Function
cj_mover さん、いつもありがとうございます。
アバタじゃなくてえくぼ、いやホクロなんですが・・・なんて冗談はおいときまして、さっそく64bitエクセルで試したところ当然ですがちゃんと作動してくれました。
助かりました。
本当はおっしゃるようにユーザーフォームを使用するべきなんですね。ただユーザーフォームってこれまでつかったことがないのでなんとなく尻込みしていました。
ユーザーフォームの方も試してみて、またわからないことがありましたら質問させていただきます。
ありがとうございました。
No.2
- 回答日時:
(2/2)
Public Function InputBoxDK( _
Prompt As String, Optional Title, Optional Default, _
Optional XPos, Optional YPos, Optional HelpFile, Optional Context _
) As String
Dim lngModHwnd As LongPtr
Dim lngThreadID As LongPtr
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
UnhookWindowsHookEx hHook
End Function
' ' 〓〓〓〓〓64ビット版、以上〓〓〓〓〓
#Else '〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
' ' 〓〓〓〓〓32ビット版、以下〓〓〓〓〓
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 GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" ( _
ByVal lpModuleName As String _
) 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 UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As Long _
) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" ( _
ByVal hDlg As Long, ByVal nIDDlgItem As Long, _
ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam 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 GetCurrentThreadId Lib "kernel32" () As Long
Private Const VER64BIT = False
Private hHook As Long
Private Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim strClassName As String
Dim RetVal As Long
Dim lngBuffer As Long
If lngCode < HC_ACTION Then
NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
Exit Function
End If
strClassName = String$(256, " ")
lngBuffer = 255
If lngCode = HCBT_ACTIVATE Then 'A window has been activated
RetVal = GetClassName(wParam, strClassName, lngBuffer)
If Left$(strClassName, CLng(RetVal)) = "#32770" Then 'Class name of the Inputbox
'This changes the edit control so that it display the password character *.
'You can change the Asc("*") as you please.
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
End If
End If
'This line will ensure that any other hooks that may be in place are
'called correctly.
CallNextHookEx hHook, lngCode, wParam, lParam
End Function
Public Function InputBoxDK( _
Prompt As String, Optional Title, Optional Default, _
Optional XPos, Optional YPos, Optional HelpFile, Optional Context _
) As String
Dim lngModHwnd As Long
Dim lngThreadID As Long
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
UnhookWindowsHookEx hHook
End Function
' ' 〓〓〓〓〓32ビット版、以上〓〓〓〓〓
#End If '〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
' ' 〓〓〓〓〓
Sub Report_Open()
If InputBoxDK("パスワードを入力して下さい") <> "password" Then
MsgBox "社員コードが間違っています。"
End If
' Debug.Print VER64BIT ' 確認用 64bit環境なら True
End Sub
' ' 〓〓〓〓〓
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Access(アクセス) Vba Userformを前面に出すについて 3 2022/04/15 12:29
- Excel(エクセル) 【マクロ】スクショ印刷がうまく動かない件 5 2022/12/06 17:37
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたいの続き 5 2023/01/24 00:16
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Visual Basic(VBA) batからexeを実行し戻り値を受け取る バッチからEXEの結果を受け取りたいのですが、 下記のバッ 1 2023/07/04 15:13
- Visual Basic(VBA) batからexeを実行し戻り値を受け取る EXEの実行内容の結果によって、戻り値を0か1かで返したい 1 2023/07/04 16:40
- Visual Basic(VBA) VBAで質問ですが、皆さんはどの様に導き出しているのでしょうか? 6 2022/05/03 21:53
- Excel(エクセル) 【VBA】 Alt+PrintScreenにてアクティブウィンドウのスクショを貼付する方法 4 2022/12/08 20:53
- Excel(エクセル) excel vba 参照渡しと値渡し 2 2022/04/27 10:45
- Visual Basic(VBA) Vba LongPtrについて教えてください 2 2022/08/19 11:14
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
今、見られている記事はコレ!
-
弁護士が解説!あなたの声を行政に届ける「パブリックコメント」制度のすべて
社会に対する意見や不満、疑問。それを発信する場所は、SNSやブログ、そしてニュースサイトのコメント欄など多岐にわたる。教えて!gooでも「ヤフコメ民について」というタイトルのトピックがあり、この投稿の通り、...
-
弁護士が語る「合法と違法を分けるオンラインカジノのシンプルな線引き」
「お金を賭けたら違法です」ーーこう答えたのは富士見坂法律事務所の井上義之弁護士。オンラインカジノが違法となるかどうかの基準は、このように非常にシンプルである。しかし2025年にはいって、違法賭博事件が相次...
-
釣りと密漁の違いは?知らなかったでは済まされない?事前にできることは?
知らなかったでは済まされないのが法律の世界であるが、全てを知ってから何かをするには少々手間がかかるし、最悪始めることすらできずに終わってしまうこともあり得る。教えてgooでも「釣りと密漁の境目はどこです...
-
カスハラとクレームの違いは?カスハラの法的責任は?企業がとるべき対応は?
東京都が、客からの迷惑行為などを称した「カスタマーハラスメント」、いわゆる「カスハラ」の防止を目的とした条例を、全国で初めて成立させた。条例に罰則はなく、2025年4月1日から施行される。 この動きは自治体...
-
なぜ批判コメントをするの?その心理と向き合い方をカウンセラーにきいた!
今や生活に必要不可欠となったインターネット。手軽に情報を得られるだけでなく、ネットを介したコミュニケーションも一般的となった。それと同時に顕在化しているのが、他者に対する辛らつな意見だ。ネットニュース...
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
相手側の携帯が電源切れてる時...
-
1コールだけ鳴るけど切れる電話...
-
ラインナップとラインアップは...
-
face book で女性の方からline ...
-
遠くにいる友達とLINE交換する...
-
風俗に行ったとして、そこで嬢...
-
line でおはようございます、の...
-
python flask から fastapiへの...
-
Windowsのバッチファイルで正規...
-
ある男子から、ライン追加され...
-
「一番上、真ん中、下」を示す英語
-
よく05(04)lineって見かけるん...
-
会社の先輩とLINE プライベート...
-
2000年生まれなのですが 00line...
-
「courtesy of the artist」の...
-
法線(normal line)はなぜそう...
-
LINEで好きな人が「笑」を全然つ...
-
教えてください
-
lineを断られた時の対処法につ...
-
毎月記念日をlineで祝うのって...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
1コールだけ鳴るけど切れる電話...
-
相手側の携帯が電源切れてる時...
-
face book で女性の方からline ...
-
ラインナップとラインアップは...
-
Windowsのバッチファイルで正規...
-
風俗に行ったとして、そこで嬢...
-
よく05(04)lineって見かけるん...
-
生産ラインの品質を表す直行率...
-
いきなりラインのトークに「新...
-
毎月記念日をlineで祝うのって...
-
「一番上、真ん中、下」を示す英語
-
遠くにいる友達とLINE交換する...
-
python flask から fastapiへの...
-
swift言語のprintln()関数で「p...
-
ある男子から、ライン追加され...
-
先輩のライン(男性)を追加した...
-
新しいクラスメイト全員のLINE...
-
会社の先輩とLINE プライベート...
-
法線(normal line)はなぜそう...
-
INIファイルからのデータ読込み...
おすすめ情報