Disabling Excel Application Resizing

[derny1]

I have an Excel app for which I would like to specify the application window size when the screen resolution is greater than 1280 wide. Setting up the window is the easy part (see code below), but, I can't seem to figure out if it is possible to disable resizing of the window afterwards, whether it be through dragging the borders or minimize/maximize (I am talking about the application and not the workbook itself).

This is a 'dictator' application which uses a worksheet as the interface and not a form, so I cannot set a border property.

I have seen mention of an Api WM_SIZE message function but I am not sure if this can be utilized in VBA.

Here is the code that sets up the applications window size and center's it on the desktop:

'WHEN SM_CXSCREEN IS > 1280, otherwise use separate zoom function

hwnd = FindWindow("XLMAIN", Application.Caption)
Call SetWindowPos(hwnd, HWND_TOPMOST, (GetSystemMetrics(SM_CXSCREEN) - 1250) / 2, (GetSystemMetrics(SM_CYSCREEN) - 760) / 2, 1250, 760, 0)

Thx,
Dennis

 

[John_w]

Try this:

Option Explicit

Public Const GWL_STYLE = (-16)
Public Const WS_THICKFRAME = &H40000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000

Public Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long


Public Sub Prevent_Window_Resize()

    Dim hWnd As Long
    Dim style As Long
    Dim ret As Long
    
    hWnd = Application.hWnd
        
    style = GetWindowLong(hWnd, GWL_STYLE)
    
    'From http://support.microsoft.com/kb/133256
    'Remove the thick frame style and the Minimise and Maximise buttons
    
    style = style And Not (WS_THICKFRAME Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX)
    ret = SetWindowLong(hWnd, GWL_STYLE, style)
    
End Sub

Note that I've used Application.hWnd to get the handle of the Excel window. This is available in Excel 2002 and later. For earlier versions you would have to use your FindWindow call.

 

[Kusaywa]

Realizing this is an old post but may be just what I need...
Does this work?
How/Where do I apply it?
Thanks

 

[mikerickson]

Kusaywa,

Consider, what happens if your code crashes. What happens if Excel crashes, What happens if Windows crashes. How will the user reset their computer and their Excel.

To be a bit blunt (and perhaps harsh) if you don't know the answer to your question, you probably shouldn't be using code like this in your workbook.

 

[Kusaywa]

No offense taken...
Is there a better way to do this?
Or am I stuck with the same distance from top and left on a 19" monitor as I am on a 24"?

Private Sub Workbook_Open()
Application.WindowState = xlNormal
    Application.Top = 20
    Application.Left = 20
    Application.Width = 920
    Application.Height = 525
End Sub

 

[Kusaywa]

When opening my workbook, it defaults to these dimensions.
This is put in ThisWorkbook
I found if I put this at sheet level, change, it reverts the workbook back to my default dimension every time something is entered.

Doesn't solve my problem of automatically centering my workbook on the desktop, just sharing in case someone else finds it handy.

Is there a way to lock in the above (or any) dimensions so they can't be changed?
Either by minimizing, maximizing or dragging the side of the window.

 

[Jaafar Tribak]

This would need subclassing the excel application window in order to intercept resizing window messages.

Unfortunately, subclassing office applications can be dangerous as pointed out by mikerickson... I am not sure but, maybe using the PeekMessage API function instead of subclassing will work however there will be a constant loop running in the background which is not dangerous but will have an impact on performance.

Which version of Office and Windows are you using bit-wise ?

 

[Kusaywa]

Well that would be a problem...
While we could get all the workstations on the same version of Office, they are running either 32 or 64 bit windows 7 at the moment.
I'm guessing what I'm doing is the way to go. Maybe users will just get tired of moving things around or resizing and just leave well enough alone.
Thanks for the help though, from everyone!

 

[Kusaywa]

What about centering it?
Have no clue where the code by the original poster goes...
Any details on how to make that work?

 

[Jaafar Tribak]

PeekMessage intercept posted messages only not sent messages ... I have just given the GetMessage API a try and although it is not the best solution, it does seem to work.

This putting this code in the ThisWorkbook module and run the Prevent_Resizing_Excel routine.. To cancel intercepting messages, run the Restore_Resizing_Excel routine.

Option Explicit

Private Type POINTAPI
  X As Long
  Y As Long
End Type

#If VBA7 Then
    Private Type MSG
        hwnd As LongPtr
        message As Long
        wParam As LongPtr
        lParam As LongPtr
        time As Long
        pt As POINTAPI
    End Type
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
#Else
    Private Type MSG
        hwnd As Long
        message As Long
        wParam As Long
        lParam As Long
        time As Long
        pt As POINTAPI
    End Type
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
#End If
    
Private bCancel As Boolean
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const WM_NCLBUTTONDBLCLK = &HA3

Public Sub Prevent_Resizing_Excel()
  
    Dim tMSG As MSG
    bCancel = False
    Do While GetMessage(tMSG, 0, 0, 0)
        If bCancel Then Exit Do
        With tMSG
            If .message <> WM_NCLBUTTONDOWN And .message <> WM_NCLBUTTONDBLCLK Then
                DoEvents
                PostMessage .hwnd, .message, .wParam, .lParam
            End If
        End With
        DoEvents
    Loop
End Sub


Public Sub Restore_Resizing_Excel()
    bCancel = True
End Sub

Private Sub Workbook_Open()

'=================================================================================

        '[B][COLOR=#008000]Any exixting code goes here before calling the 'Restore_Resizing_Excel' routine[/COLOR][/B]

'=================================================================================

    Call Prevent_Resizing_Excel

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call Restore_Resizing_Excel
End Sub