Minimize Userform 32bit to 64bit solution

Question

I would like to help me with the code i should use for windows 7 64bit. Curently, for windows 7 32bit i am using the code below, which displays minimize/maximize button on Userform and disables maximize button. Is there a 64bit solution for this? Can i control someway my macro, so it identifies system windows version?

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

Thanks in advance!

you mean you are [using a 64bit version of Office and need to declare the variables with the SafePtr attribute?](http://stackoverflow.com/questions/4251111/how-to-make-vba-code-compatible-for-office-2010-64-bit-version-and-older-offic) — , Oct 20 '14 at 14:36

score 0 · Answer 1 · answered Aug 29 '17 at 19:49

0

you have to add the PtrSafe Clause after each Declare statement, "Declare PrtSafe", and also change all "long" types for "longPtr"

Then it should work in both 32 and 64 bits versions.

answered Aug 29 '17 at 19:49

Carlos Andres Vivares Mira

1
1

score 0 · Answer 2 · answered Oct 26 '17 at 10:45

This is the complete solution foe 32bit and 64bit office and windows 64 bit and 32bit.

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

and we add this code at form code window

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

at last here is a video from my channel https://www.youtube.com/watch?v=E01Giu8-o0o my best regards M.A.S

Minimize Userform 32bit to 64bit solution

2 Answers2