VBA窗体前置的方法

VBA窗体在某些时候需要置顶,方便此窗口在其他打开的程序或者Excel页面上展示。一般来说实际的运用场景是,本窗体输入需要在其他页面上查看数据,此时,窗体需要置顶。

在VBE窗体模块相应的窗体中输入下面的代码即可实现。

窗体置顶全部代码
#If VBA7 And Win64 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongLong, ByVal nIndex As LongLong) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongLong, ByVal nIndex As LongLong, ByVal dwNewLong As LongLong) As LongLong
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongLong, ByVal hWndInsertAfter As LongLong, ByVal x As LongLong, ByVal y As LongLong, ByVal cx As LongLong, ByVal cy As LongLong, ByVal wFlags As LongLong) As LongLong
#Else
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#End If

Private Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const GWL_HWNDPARENT = (-8)
'=====================================
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const HWND_TOPMOST = -1
'=====================================
Private Sub UserForm_Initialize()
'初始化窗体
    Dim hwndDesktop As Long
    Dim hwndMe As Long
    Dim lStyle As Long
    '获取userform句柄
    hwndMe = FindWindow(vbNullString, Me.Caption)
    '获取桌面句柄
    hwndDesktop = GetDesktopWindow
    'MsgBox hwndMe & ":" & hwndDesktop
    '设置userform的owner为桌面,使userform不随excel主窗口最小化而最小化
    SetWindowLong hwndMe, GWL_HWNDPARENT, hwndDesktop
    '让userform显示最大化、最小化按钮
    lStyle = GetWindowLong(hwndMe, GWL_STYLE) 'Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX
    SetWindowLong hwndMe, GWL_STYLE, lStyle
    '窗口置顶
    SetWindowPos hwndMe, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_NOSIZE
    'If Err Then MsgBox Err.Description
    'MQOpenFlag = True
    'Application.WindowState = xlMinimized
End Sub

本代码虽然做了64位、32位office的兼容,但表现却不一样。32位office可以只是窗体本身被置顶。64位office会把窗体和excel文档一起置顶。

因此,在调用窗体的代码中,建议加入Application.WindowState = xlMinimized这句代码来最小化文档。

因为网上的代码都没做64位office兼容,也许是本人水平有限,写的64位兼容代码导致的以上问题。如有高手精通vba API兼容,请指正为谢。

posted @ 2022-10-05 09:44  仇朝权  阅读(1262)  评论(0编辑  收藏  举报