How to force a window to be of certain size?

  • Thread starter Thread starter Marvin Hlavac
  • Start date Start date
M

Marvin Hlavac

Is it at all possible to force a workbook window to be of certain size at
all times and don't let the user make it smaller?
 
Sure. For the workbook window, all you have to do is to protect the workbook
(not the worksheet) and check "Windows" in the dialog. For the application
window, though, you will need to use some Windows API functions.
 
Hi Vasant,

Thanks, I tried to protect the workbook and checked "Windows"... and the
result made me realize what I really need is to freeze the size of MS Excel
window. And I have no clue how to do that (so I will most likely give up :-)
 
Don't give up; try this:

Option Explicit

Private Declare Function GetSystemMenu Lib "user32" _
(ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName _
As String) As Long

Public Sub DisableSystemMenu()
Dim lHandle As Long
On Error Resume Next
lHandle = FindWindowA(vbNullString, Application.Caption)
If lHandle <> 0 Then
DeleteMenu GetSystemMenu(lHandle, False), 0, 1024
DeleteMenu GetSystemMenu(lHandle, False), 1, 1024
DeleteMenu GetSystemMenu(lHandle, False), 1, 1024
DeleteMenu GetSystemMenu(lHandle, False), 1, 1024
End If
End Sub

Public Sub EnableSystemMenu()
Dim lHandle As Long
On Error Resume Next
lHandle = FindWindowA(vbNullString, Application.Caption)
GetSystemMenu lHandle, True
End Sub
 
Option Explicit
Private Declare Function GetSystemMenu Lib "user32" _
(ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName _
As String) As Long

Public Sub DisableSystemMenu()
Dim lHandle As Long
On Error Resume Next
lHandle = FindWindowA(vbNullString, Application.Caption)
If lHandle <> 0 Then
DeleteMenu GetSystemMenu(lHandle, False), 0, 1024
DeleteMenu GetSystemMenu(lHandle, False), 1, 1024
DeleteMenu GetSystemMenu(lHandle, False), 1, 1024
DeleteMenu GetSystemMenu(lHandle, False), 1, 1024
End If
End Sub

Public Sub EnableSystemMenu()
Dim lHandle As Long
On Error Resume Next
lHandle = FindWindowA(vbNullString, Application.Caption)
GetSystemMenu lHandle, True
End Sub
Click to expand...



Hi Vasant,

I tried to paste all of the above to VBAProject | ThisWorkbook but nothing
happened. Was I supposed to paste it there? If it works it would be very,
very helpful to me.
 
Hi Marvin:

Paste the code in a new, standard module (not the ThisWorkbook module). It
works perfectly for me and should work for you. Just watch the line breaks
in the code to make sure it's not messed up.

Regards,

Vasant.
 
To clarify, the sub DisableSystemMenu will disable the Restore, Size,
Maximize and Minimize actions. EnableSystemMenu will restore them.
 
Vasant, so far no luck. I just tried it in a new workbook. I pasted it in a
new module. I must be either doing something wrong or there is something
wrong with Windows on this pc. I can try it tomorrow on another machine.
 
Marvin, forgive me if this is a stupid question, but are you actually
running the procedure? Just putting it in a Sub will not do anything; you
need a way to trigger the code.

If you want it to run automatically when a certain workbook is opened, then
you will have to call the code from the Workbook_Open event. Of course, you
will need to set the application window to your desired size first.

Regards,

Vasant
 
Vasant that was not a stupid question, that was the right question. I
assumed all I needed to do was to paste the code, save, close and open ;-)

Now that we know the problem is me, what do I do next to make it work every
time I open a workbook and I want it to be of a size e.g. 500x500 pixels?
 
Hi Marvin:

You already have the previously supplied code in a standard module. Now
paste the following code into the ThisWorkbook module:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not Saved Then
'Adapted from John Walkenbach
Select Case MsgBox("Do you want to save the changes you made to " _
& "'" & Name & "'?", vbExclamation + vbYesNoCancel, "Microsoft
Excel")
Case vbYes
Save
Case vbNo
Saved = True
Case vbCancel
Cancel = True
Exit Sub
End Select
End If
Application.WindowState = xlMaximized
EnableSystemMenu
End Sub

Private Sub Workbook_Open()
With Application
.WindowState = xlNormal
.Height = 500
.Width = 500
End With
DisableSystemMenu
End Sub

Let me know how it works out!

Regards,

Vasant.
 
Hi Vasant,

Thanks very very much for your kind help with this. Especially thank you for
your patience with me ;-)

It works beautifully. One can still use the maximize button though. That is
not that big of a problem. The main think is that a user cannot make the
window smaller then intended.
 
I'm glad it worked for you, Marvin; but when I run the code, the Maximize
functionality is also disabled. I don't know why it's not working for you.
Two questions:

1. What version of Excel are you using? I'm using 2002. I know that in Excel
97 (I don't know about 2000), there was a little glitch with one of the
buttons.

2. In the Disable code, there are two lines that are repeated. This is on
purpose. Did you paste the code exactly as provided or did you remove the
lines that you thought were duplicated and redundant?

Except for the above possibilities, I have no explanation. I'm just curious,
so let me know!

Regards,

Vasant.
 
I tried it at work this morning and now again at home with the same result.
Maximize button is the only way to change the size. There is however no way
to make the window smaller which is what I needed so I'm happy. I tried it
both times with a new empty workbook. My Excel is the version from MS
OfficeXP. I didn't do any change to the code you pasted.

I'm again happy with the result so there is no need to worry about the
little maximize button glitch. Thanks again Vasant!

--
Regards,
Marvin Hlavac
Toronto, Canada
 
Back
Top