最小化Userform 32位到64位解决方案

Question

我想帮助我使用Windows 7 64位的代码。 确实，对于Windows 7 32位，我使用下面的代码，它显示Userform上的最小化/最大化按钮并禁用最大化按钮。 这是否有一个64位的解决方案？ 我可以控制一些我的宏，所以它识别系统的Windows版本？

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 

在此先感谢！

Answer 1

你必须添加PTRSAFE条款后，每个声明声明，“声明PrtSafe”，并改变所有“长”类型“longPtr”

那么就应该在32个和64位版本。

Answer 2

这是完整的解决方案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