最小化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

在此先感謝！

來源

2014-10-20 Golemic

您的意思是[使用64位版本的Office並需要使用SafePtr屬性聲明變量？]（http://stackoverflow.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

你必須添加PTRSAFE條款後，每個聲明聲明，「聲明PrtSafe」，並改變所有「長」類型「longPtr」

那麼就應該在32個和64位版本。

來源

2017-08-29 19:49:42

這是完整的解決方案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

來源

2017-10-26 10:45:03 OstazMas

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

回答

相關問題