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

分類:[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
ASP.NET、C++/CLI、Java 何でもどうぞ

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