最小化Userform 32位到64位解决方案
问题描述:
我想帮助我使用Windows 7 64位的代码。 确实,对于Windows 7 32位,我使用下面的代码,它显示Userform上的最小化/最大化按钮并禁用最大化按钮。 这是否有一个64位的解决方案? 我可以控制一些我的宏,所以它识别系统的Windows版本?最小化Userform 32位到64位解决方案
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Const GWL_STYLE As Long = (-16)
Private Const WS_SYSMENU As Long = &H80000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const SW_SHOWMAXIMIZED = 3
Private Sub UserForm_Activate()
Dim lFormHandle As Long, lStyle As Long
lFormHandle = FindWindow("ThunderDFrame", ReportOutput.Caption)
lStyle = GetWindowLong(lFormHandle, GWL_STYLE)
lStyle = lStyle Or WS_SYSMENU
lStyle = lStyle Or WS_MINIMIZEBOX
SetWindowLong lFormHandle, GWL_STYLE, (lStyle)
DrawMenuBar lFormHandle
End Sub
在此先感谢!
答
你必须添加PTRSAFE条款后,每个声明声明,“声明PrtSafe”,并改变所有“长”类型“longPtr”
那么就应该在32个和64位版本。
答
这是完整的解决方案32位和64位的办公室和Windows 64位和32位。
Option Explicit
'API functions
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long _
) As LongPtr
#Else
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long _
) As LongPtr
#End If
#If Win64 Then
Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr _
) As LongPtr
#Else
Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr _
) As LongPtr
#End If
Private 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 LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As LongPtr
Private Declare PtrSafe Function GetActiveWindow Lib "user32.dll"() As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As LongPtr, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any _
) As LongPtr
Private Declare PtrSafe Function DrawMenuBar Lib "user32" _
(ByVal hWnd As LongPtr) As LongPtr
#Else
Private Declare Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long _
) As Long
Private Declare Function SetWindowLongPtr 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
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As Long
Private Declare Function GetActiveWindow Lib "user32.dll"() As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any _
) As Long
Private Declare Function DrawMenuBar Lib "user32" _
(ByVal hWnd As Long) As Long
#End If
'Constants
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
Sub AddIcon(myForm)
'Add an icon on the titlebar
#If VBA7 Then
Dim hWnd As LongPtr
Dim lngRet As LongPtr
#Else
Dim hWnd As Long
Dim lngRet As Long
#End If
Dim hIcon As Long
hIcon = Sheet1.Image1.Picture.Handle
hWnd = FindWindow(vbNullString, myForm.Caption)
lngRet = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
lngRet = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
lngRet = DrawMenuBar(hWnd)
End Sub
Sub AddMinimizeButton()
'Add a Minimize button to Userform
#If VBA7 Then
Dim hWnd As LongPtr
#Else
Dim hWnd As Long
#End If
hWnd = GetActiveWindow
Call SetWindowLongPtr(hWnd, GWL_STYLE, _
GetWindowLongPtr(hWnd, GWL_STYLE) Or _
WS_MINIMIZEBOX)
Call SetWindowPos(hWnd, 0, 0, 0, 0, 0, _
SWP_FRAMECHANGED Or _
SWP_NOMOVE Or _
SWP_NOSIZE)
End Sub
Sub AppTasklist(myForm)
'Add this userform into the Task bar
#If VBA7 Then
Dim WStyle As LongPtr
Dim Result As LongPtr
Dim hWnd As LongPtr
#Else
Dim WStyle As Long
Dim Result As Long
Dim hWnd As Long
#End If
hWnd = FindWindow(vbNullString, myForm.Caption)
WStyle = GetWindowLongPtr(hWnd, GWL_EXSTYLE)
WStyle = WStyle Or WS_EX_APPWINDOW
Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or _
SWP_NOSIZE Or _
SWP_NOACTIVATE Or _
SWP_HIDEWINDOW)
Result = SetWindowLongPtr(hWnd, GWL_EXSTYLE, WStyle)
Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or _
SWP_NOSIZE Or _
SWP_NOACTIVATE Or _
SWP_SHOWWINDOW)
End Sub
,我们在表单代码窗口
Private Sub CommandButton1_Click()
Application.Visible = 1
End Sub
Private Sub UserForm_Activate()
Application.Visible = 0
AddIcon Me 'Add an icon on the titlebar
AddMinimizeButton 'Add a Minimize button to Userform
AppTasklist Me 'Add this userform into the Task bar
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.Visible = 1
End Sub
终于在这里添加此代码是从我的频道的视频 https://www.youtube.com/watch?v=E01Giu8-o0o 我最诚挚的问候 MAS
您的意思是[使用64位版本的Office并需要使用SafePtr属性声明变量?](http://*.com/questions/4251111/how-to-make-vba-code-compatible-for-office-2010-64-bit -version-and-older-offic) – 2014-10-20 14:36:36
嘿vba4all,这是正确的,但我不知道该怎么做。 – Golemic 2014-10-20 14:47:59
您读过@ vba4all的链接了吗?它告诉你如何... – Blackhawk 2014-10-20 14:57:58