让excel窗⼝置顶(可以⽤于Win64或者Win32)
'Update 20140909
#If Win64 Then
Public Declare PtrSafe Function SetWindowPos _
Lib "user32" ( _
ByVal hwnd As LongPtr, _
ByVal hwndInsertAfter As LongPtr, _
ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) _
As Long
#Else
Public 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
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
excel口内打 或者xPublic Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Sub ShowXLOnTop(ByVal OnTop As Boolean)
Dim xStype As Long
#If Win64 Then
Dim xHwnd As LongPtr
#Else
Dim xHwnd As Long
#End If
If OnTop Then
xStype = HWND_TOPMOST
Else
xStype = HWND_NOTOPMOST
End If
Call SetWindowPos(Application.hwnd, xStype, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
End Sub
Sub SetXLOnTop()
ShowXLOnTop True
End Sub
Sub SetXLNormal()
ShowXLOnTop False
End Sub
以上代码:如果是win64位,只留下If分⽀的代码,代码如下:
Public Declare PtrSafe Function SetWindowPos _
Lib "user32" ( _
ByVal hwnd As LongPtr, _
ByVal hwndInsertAfter As LongPtr, _
ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) _
As Long
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Sub ShowXLOnTop(ByVal OnTop As Boolean)
Dim xStype As Long
Dim xHwnd As LongPtr
If OnTop Then
xStype = HWND_TOPMOST
Else
xStype = HWND_NOTOPMOST
End If
Call SetWindowPos(Application.hwnd, xStype, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
End Sub
Sub SetXLOnTop()
ShowXLOnTop True
End Sub
Sub SetXLNormal()
ShowXLOnTop False
End Sub
4、保存关闭VB窗⼝
5、excel窗⼝-启动宏(Alt+F8)
6、在宏窗⼝中选择需要的选项:
SetXLOnTop:窗⼝置顶
SetXLNormal:窗⼝恢复
选择SetXLOnTop:执⾏则窗⼝置顶,任意时候回到宏窗⼝(Alt+F8)执⾏SetXLNormal:则恢复。
版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198,我们将在24小时内删除。
发表评论