minimize button - 64 bit userform

[nparsons75]

Hi, I need to add a minimize button to an excel vba userform but 64 bit. Would anyone be able to assist, I have looked over the net but cannot find a straight forward solution.

Thank you.

 

[Jaafar Tribak]

Post here the code you already have for 32bits and I or someone else here should be able to adapt it for 64bit

 

[nparsons75]

Thats great, thanks.

Code is:

[COLOR=#333333]Private Const GWL_STYLE As Long = -16[/COLOR]Public Const MIN_BOX As Long = &H20000
Public Const MAX_BOX As Long = &H10000

Const SC_CLOSE As Long = &HF060
Const SC_MAXIMIZE As Long = &HF030
Const SC_MINIMIZE As Long = &HF020
Const SC_RESTORE As Long = &HF120

 Private Declare Function GetWindowLong _
   Lib "user32.dll" _
    Alias "GetWindowLongA" _
     (ByVal hwnd As Long, _
      ByVal nIndex As Long) As Long
               
 Private Declare Function SetWindowLong _
  Lib "user32.dll" _
   Alias "SetWindowLongA" _
    (ByVal hwnd As Long, _
     ByVal nIndex As Long, _
     ByVal dwNewLong As Long) As Long
     
'Redraw the Icons on the Window's Title Bar
 Private Declare Function DrawMenuBar _
  Lib "user32.dll" _
   (ByVal hwnd As Long) As Long

'Returns the Window Handle of the Window accepting input
 Private Declare Function GetForegroundWindow _
  Lib "user32.dll" () As Long

Public Sub AddToForm(ByVal Box_Type As Long)

 Dim BitMask As Long
 Dim Window_Handle As Long
 Dim WindowStyle As Long
 Dim Ret As Long

   If Box_Type = MIN_BOX Or Box_Type = MAX_BOX Then
      Window_Handle = GetForegroundWindow()
  
       WindowStyle = GetWindowLong(Window_Handle, GWL_STYLE)
       BitMask = WindowStyle Or Box_Type
  
      Ret = SetWindowLong(Window_Handle, GWL_STYLE, BitMask)
      Ret = DrawMenuBar(Window_Handle)
   End If
 [COLOR=#333333]End Sub[/COLOR]

Code to run, not sure where this needs to go?

[COLOR=#333333]Private Sub UserForm_Activate()[/COLOR]  AddToForm MIN_BOX [COLOR=#333333]End sub[/COLOR]

 

[Jaafar Tribak]

1- Place this code in a standard module :

Option Explicit

Public Const MIN_BOX As Long = &H20000
Public Const MAX_BOX As Long = &H10000


Const GWL_STYLE As Long = -16
Const SC_CLOSE As Long = &HF060
Const SC_MAXIMIZE As Long = &HF030
Const SC_MINIMIZE As Long = &HF020
Const SC_RESTORE As Long = &HF120


Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long
Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr


Public Sub AddToForm(ByVal Box_Type As Long)
    Dim BitMask As LongPtr
    Dim Window_Handle As LongPtr
    Dim WindowStyle As LongPtr
    Dim Ret As LongPtr

    If Box_Type = MIN_BOX Or Box_Type = MAX_BOX Then
        Window_Handle = GetForegroundWindow()
        WindowStyle = GetWindowLongPtr(Window_Handle, GWL_STYLE)
        BitMask = WindowStyle Or Box_Type
        Ret = SetWindowLongPtr(Window_Handle, GWL_STYLE, BitMask)
        Ret = DrawMenuBar(Window_Handle)
    End If
 End Sub

2- Place this code in the UserForm module:

Option Explicit

Private Sub UserForm_Activate()
    AddToForm MIN_BOX
End Sub

 

[nparsons75]

Fantastic, works a treat... thank you for your time, really appreciated.

 

[Norie]

Jaafar

Just curious, is that code designed to work for both 32 and 64 bit?

The reason I ask is because I tested it on 32 bit and it worked.

 

[Jaafar Tribak]

Hi Norie,

No. It won't work for 32Bit ... The one posted by nparsons75 will

If you are interested in having code that works for both 32 and 64Bits I can post it for you later on

 

[Norie]

I'm pretty sure it was the code you posted I tried on my Excel 32 bit and it worked.

I'll check again later when I'm back home.