Formを常に前面

VBA

Excelは 2013からSDIを採用。

SDIになって、最初にこまったのがFormの管理。

UserForm を Modelessモードで表示し時、別のブックに切り替えると UserFormがブックの下に隠れてしまう。
UserFormをアクティブすると必ず、UserFormを起動したブックのウインドウが前に来てしまいます。

つまり、全てのブックの前に UserFormを表示することが簡単に出来なくなってしまったのです。

ネットでは、当時その問題を解決する方法が 色々話題になってたように記憶しています。

で、海外のどこだったのサイトで、分かりやすいのがあってそれを当時採用しました。(この記事を書く時、探してみたが見つからない。。)

最近その手のフォームを利用することがなかったのですが、ちょっと使うことがあって 覚書。

Option Explicit
'■ Form_Module

Private WithEvents XLApp As Excel.Application

Dim mXLHwnd As LongPtr      'Excel's window handle
Dim mhwndForm As LongPtr    'userform's window handle

#If VBA7 Then               'Excel2010(ver14)-
    '32/64bit
    'キャプション名からウインドウハンドルを取得
    Private Declare PtrSafe Function FindWindowA Lib "user32" ( _
                                        ByVal lpClassName As String, _
                                        ByVal lpWindowName As String _
                                        ) As LongPtr
    
    '指定ウィンドウ最前面&アクティブにする
    Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    
    #If Win64 Then
        '64bit
        'ウインドウの属性変更  SetWindowLongA(ウインドウハンドル, 変更するデータの指定, 新しい値)
        Private Declare PtrSafe Function SetWindowLongA Lib "user32" Alias "SetWindowLongPtrA" ( _
                                        ByVal hwnd As LongPtr, _
                                        ByVal nIndex As Long, _
                                        ByVal dwNewLong As LongPtr _
                                        ) As LongPtr
    
    #Else
        '32bit
        Private Declare PtrSafe Function SetWindowLongA Lib "user32" ( _
                                        ByVal hwnd As LongPtr, _
                                        ByVal nIndex As Long, _
                                        ByVal dwNewLong As LongPtr _
                                        ) As LongPtr
    #End If
#End If

Const GWL_HWNDPARENT As Long = -8   '親ウィンドウのハンドル

'■ UserForm_Initialize -------------------------------------------
Private Sub UserForm_Initialize()
    'Excel2013(ver15)-  SDI
    If Val(Application.Version) >= 15 Then
        Set XLApp = Application
        'ユーザーフォームのハンドルをCaption名から取得
        mhwndForm = FindWindowA("ThunderDFrame", Caption)
    End If
End Sub

'■ WindowActivate ---------------------------------------------
Private Sub XLApp_WindowActivate(ByVal Wb As Workbook, ByVal Wn As Window)
    mXLHwnd = Application.hwnd
    SetWindowLongA mhwndForm, GWL_HWNDPARENT, mXLHwnd
    SetForegroundWindow mhwndForm
End Sub

'■ WorkbookBeforeClose --------------------------------------------
Private Sub XLApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
    SetWindowLongA mhwndForm, GWL_HWNDPARENT, 0&
End Sub

コメント

タイトルとURLをコピーしました