C# と VB.NET の質問掲示板

ASP.NET、C++/CLI、Java 何でもどうぞ

C# と VB.NET の入門サイト

Re[2]: Excel 2010 で WndProc が機能しない


(過去ログ 111 を表示中)
掲示板トップ C# と VB.NET 入門 新規作成 利用方法/規約 トピック表示 ランキング 記事検索 過去ログ

[トピック内 3 記事 (1 - 3 表示)]　 << 0 >>

■65841 / inTopicNo.1) 　Excel 2010 で WndProc が機能しない
  ▼■
□投稿者/ doragora (8回)-(2013/03/20(Wed) 17:27:10)

分類:[Microsoft Office 全般]　

度々の質問すみません。

Excel 2010でも動作させる必要になったのですが、WndProcの処理が走りません。
またMSDNでは GetWindowLongPtr を推奨となっていますが、Excelが落ちます。
2010の最小コードでも動作しないので、お知恵を拝借出来ればと思います。

※Excel x86 x64両対応

☆Sheet
Option Explicit
Private Sub CommandButton1_Click()
    UserForm1.Show vbModeless
End Sub

☆UserForm1
Option Explicit

Private hWnd As LongPtr

Private Sub UserForm_Initialize()

    hWnd = FindWindow(StrPtr(vbNullString), StrPtr(Me.Caption))
    PrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf Module1.WndProc)
    
End Sub

Private Sub UserForm_Terminate()
    Dim ret As LongPtr
    ret = SetWindowLong(hWnd, GWL_WNDPROC, PrevWndProc)
End Sub

☆Module1
Option Explicit

Public Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowW" _
        (ByVal lpClassName As LongPtr, _
         ByVal lpWindowName As LongPtr) As LongPtr

' ***** WinUser.h 読みやすく整形
'#ifdef _WIN64
'   WINUSERAPI LONG_PTR WINAPI GetWindowLongPtrA(__in HWND hWnd, __in int nIndex);
'   WINUSERAPI LONG_PTR WINAPI GetWindowLongPtrW(__in HWND hWnd, __in int nIndex);
'   #ifdef UNICODE
'       #define GetWindowLongPtr  GetWindowLongPtrW
'   #else
'       #define GetWindowLongPtr  GetWindowLongPtrA
'   #endif // !UNICODE
'   WINUSERAPI LONG_PTR WINAPI SetWindowLongPtrA(__in HWND hWnd, __in int nIndex, __in LONG_PTR dwNewLong);
'   WINUSERAPI LONG_PTR WINAPI SetWindowLongPtrW(__in HWND hWnd, __in int nIndex, __in LONG_PTR dwNewLong);
'   #ifdef UNICODE
'       #define SetWindowLongPtr  SetWindowLongPtrW
'   #else
'       #define SetWindowLongPtr  SetWindowLongPtrA
'   #endif // !UNICODE
'#else  /* _WIN64 */
'   #define GetWindowLongPtrA   GetWindowLongA
'   #define GetWindowLongPtrW   GetWindowLongW           ' x86環境ではGetWindowLongPtrXは実装されておらず、GetWindowLongXを使う
'   #ifdef UNICODE
'       #define GetWindowLongPtr  GetWindowLongPtrW
'   #else
'       #define GetWindowLongPtr  GetWindowLongPtrA
'   #endif // !UNICODE
'   #define SetWindowLongPtrA   SetWindowLongA
'   #define SetWindowLongPtrW   SetWindowLongW
'   #ifdef UNICODE
'       #define SetWindowLongPtr  SetWindowLongPtrW
'   #else
'       #define SetWindowLongPtr  SetWindowLongPtrA
'   #endif // !UNICODE
'#endif /* _WIN64 */

'#If Win64 Then
' SetWindowLongPtrW を 2010 x64 で使おうとするとExcelが落ちる
' 2007(x86) & 2010 x86 では SetWindowLongPtrW が無い　＝　x86 x64 どちらも SetWindowLongW でいい？
'Public Declare PtrSafe Function SetWindowLong Lib "User32" Alias "SetWindowLongPtrW" _
        (ByVal hWnd As LongPtr, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As LongPtr) As LongPtr
'#Else
Public Declare PtrSafe Function SetWindowLong Lib "User32" Alias "SetWindowLongW" _
        (ByVal hWnd As LongPtr, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As LongPtr) As LongPtr
'#End If

Public Declare PtrSafe Function CallWindowProc Lib "User32" Alias "CallWindowProcW" _
        (ByVal WndProc As LongPtr, _
        ByVal hWnd As LongPtr, _
        ByVal uMsg As Long, _
        ByVal wParam As LongPtr, _
        ByVal lParam As LongPtr) As LongPtr

Public PrevWndProc As LongPtr

Public Const GWL_WNDPROC = (-4)

Public Function WndProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

    Debug.Print uMsg
    WndProc = CallWindowProc(PrevWndProc, hWnd, uMsg, wParam, lParam)
    
End Function

引用返信 編集キー/
■65844 / inTopicNo.2) 　Re[1]: Excel 2010 で WndProc が機能しない
▲▼■
□投稿者/ 魔界の仮面弁士 (177回)-(2013/03/20(Wed) 19:09:17) 
■No65841 (doragora さん) に返信
> またMSDNでは GetWindowLongPtr を推奨となっていますが、Excelが落ちます。

Initialize の最中ではなく、「Initialize が終わった後」でサブクラス化してみては如何でしょう。


Option Explicit

Private hwnd As LongPtr

Private Sub UserForm_Initialize()
    hwnd = Module1.FindWindow(StrPtr(vbNullString), StrPtr(Me.Caption))
End Sub

Private Sub UserForm_Activate()
#If Win64 Then
    If Module1.PrevWndProc <> 0^ Then
        Exit Sub
    End If
    Module1.PrevWndProc = Module1.SetWindowLongPtrW(hwnd, GWLP_WNDPROC, AddressOf Module1.WndProc)
#Else
    If Module1.PrevWndProc <> 0& Then
        Exit Sub
    End If
    Module1.PrevWndProc = Module1.SetWindowLongW(hwnd, GWL_WNDPROC, AddressOf Module1.WndProc)
#End If

'    MsgBox CStr(Err.Number) & vbNewLine & _
'           CStr(Err.LastDllError) & vbNewLine & _
'           Err.Description, vbInformation, _
'           CStr(Module1.PrevWndProc)
End Sub

Private Sub UserForm_Terminate()
    Dim ret As LongPtr
#If Win64 Then
    If Module1.PrevWndProc <> 0^ Then
        ret = Module1.SetWindowLongPtrW(hwnd, GWL_WNDPROC, Module1.PrevWndProc)
        Module1.PrevWndProc = 0^
    End If
#Else
    If Module1.PrevWndProc <> 0& Then
        ret = Module1.SetWindowLongW(hwnd, GWL_WNDPROC, Module1.PrevWndProc)
        Module1.PrevWndProc = 0&
    End If
#End If
'    MsgBox "Done:" & CStr(ret), vbInformation, CStr(Module1.PrevWndProc)
End Sub
引用返信 編集キー/
■65852 / inTopicNo.3) 　Re[2]: Excel 2010 で WndProc が機能しない
▲▼■
□投稿者/ doragora (9回)-(2013/03/20(Wed) 21:41:20) 
■No65844 (魔界の仮面弁士 さん) に返信
> Initialize の最中ではなく、「Initialize が終わった後」でサブクラス化してみては如何でしょう。

うまくいきました。Excel 2007ではうまくいっていたので、これもVBA6→VBA7の違いなんですかね。

なるべく標準モジュールで#if〜#endifに対応したいので、下記の様にしました。
ありがとうございました。

☆同じ問題になった人へ
※UserForm1でModule1.〜と指定している(WndProc、PrevWndProc)のは複数のWndProc処理が必要になった場合の為
　クラス化出来ればベストだけど、AddressOfが可能なのは標準モジュールのみの為
　ただし実際に、同名関数や同名変数が使えるのかは未検証

※下記コードのModule1は省略してますが、UserForm1のコードはExcel 2007以前を意識しています。

☆Module1
...
#If Win64 Then
Public Const LongPtr_Zero As LongPtr = 0^
Public Declare PtrSafe Function SetWindowLongPtr Lib "User32" Alias "SetWindowLongPtrW" _
        (ByVal hWnd As LongPtr, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As LongPtr) As LongPtr
#Else
Public Const LongPtr_Zero As LongPtr = 0&
Public Declare PtrSafe Function SetWindowLongPtr Lib "User32" Alias "SetWindowLongW" _
        (ByVal hWnd As LongPtr, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As LongPtr) As LongPtr
#End If
...

☆UserForm1
Option Explicit

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

Private Sub UserForm_Initialize()
    hWnd = FindWindow(StrPtr(vbNullString), StrPtr(Me.Caption))
End Sub

Private Sub UserForm_Activate()
    If Module1.PrevWndProc <> LongPtr_Zero Then
        Exit Sub
    End If
    Module1.PrevWndProc = SetWindowLongPtr(hWnd, GWL_WNDPROC, AddressOf Module1.WndProc)
End Sub

Private Sub UserForm_Terminate()
#If VBA7 Then
    Dim ret As LongPtr
#Else
    Dim ret As Long
#End If
    
    If Module1.PrevWndProc <> LongPtr_Zero Then
        ret = SetWindowLongPtr(hWnd, GWL_WNDPROC, Module1.PrevWndProc)
        Module1.PrevWndProc = LongPtr_Zero
    End If
End Sub
解決済み
引用返信 編集キー/


トピック内ページ移動 / << 0 >>

このトピックに書きこむ

過去ログには書き込み不可

管理者用

- Child Tree -