I do not know how to make the simplest in the world resizable UserForm. What I have seen on different forum threads are terrible behemots (huge as the Universe libraries doing too much). But I need a simple, one stroke solution and I hope it exists. At this moment I have this code:
Dim myForm As UserForm1
Set myForm = New UserForm1
myForm.Caption = "Attributes"
myForm.Show
And I have UserForm_Initialize() which does some extra work. What is horrible (unreasonable?) is that by default a form is not resizable.
Here's a simple guide on how to make a userform drag and re-sizable.
http://www.mrexcel.com/forum/excel-questions/558649-userform-movable-resizable.html
Here is transcribed solution from
https://www.mrexcel.com/board/threads/resize-a-userform.485489/
I have tested it and it works
First add these declaration to your header
'Declaration for form resize
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare Function SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long) As Long
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
Add this sub to your form
Private Sub MakeFormResizable()
'Written: August 02, 2010
'Author: Leith Ross
'Summary: Makes the UserForm resizable by dragging one of the sides. Place a call
' to the macro MakeFormResizable in the UserForm'
'from https://www.mrexcel.com/board/threads/resize-a-userform.485489/
Dim lStyle As Long
Dim hWnd As Long
Dim RetVal
Const WS_THICKFRAME = &H40000
Const GWL_STYLE As Long = (-16)
hWnd = GetActiveWindow
'Get the basic window style
lStyle = GetWindowLong(hWnd, GWL_STYLE) Or WS_THICKFRAME
'Set the basic window styles
RetVal = SetWindowLong(hWnd, GWL_STYLE, lStyle)
'Clear any previous API error codes
SetLastError 0
'Did the style change?
If RetVal = 0 Then MsgBox "Unable to make UserForm Resizable."
End Sub
And finally call this sub from your Userform_Activate
Private Sub UserForm_Activate()
MakeFormResizable
End Sub
Related
I am using below code to open an email item (with specific conditions).
I need after that to maximize the opened outlook email window and set focus for it to be foreground.
Option Explicit
Option Compare Text
Public WithEvents MyItem As Outlook.MailItem
Public EventsDisable As Boolean
Private Sub Application_ItemLoad(ByVal Item As Object)
If EventsDisable = True Then Exit Sub
If Item.Class = olMail Then
Set MyItem = Item
End If
End Sub
Private Sub myItem_Open(Cancel As Boolean)
EventsDisable = True
If MyItem.Subject = "Auto Plan" And Application.ActiveExplorer.CurrentFolder.Name = "MyTemplate" Then
'Code to maximize the opened outlook email window and set focus for it to be foreground
End If
EventsDisable = False
End Sub
the following Windows API function
#If Win64 Then
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" _
(ByVal hWnd As LongPtr) As LongPtr
#Else
Private Declare Function SetForegroundWindow Lib "user32" _
(ByVal hWnd As Long) As Long
#End If
Public Sub Bring_to_front()
Dim setFocus As Long
setFocus = SetForegroundWindow(xxxxxxx.hWnd)
End Sub
thanks for any useful comments and answer.
Call MailItem.Display, then activate the Inspector object by calling Inspector.Activate. Inspector object can be retrieved from MailItem.GetInspector.
One thing to keep in mind is that Windows will not bring a window to the foreground if the parent process is not in the foreground. You would need to use AttachThreadInput function for that - see https://stackoverflow.com/a/17793132/332059
You can use the SetForegroundWindow method which brings the thread that created the specified window into the foreground and activates the window. Keyboard input is directed to the window, and various visual cues are changed for the user. Alternatively you may consider using the Activate method of the Explorer or Inspector classes from the Outlook object model.
To maximize the window you could use the ShowWindow method from Windows API, here is a possible declaration in VBA:
Public Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdSHow As Long) As Long
private SW_MAXIMIZE as Long = 3;
private SW_MINIMIZE as Long = 6;
So, you need to pass a window handle and the SW_MAXIMIZE value as the second parameter to maximize the window. See How to minimize/maximize opened Applications for more information.
In order to activate "the opened outlook email message window" you need to "determine its handle". In order to do that you may use its caption.
Please, use the next declarations on top of a standard module (in the declarations area):
Public Const MyApp As String = "myOutlook", Sett As String = "Settings", wHwnd As String = "Wind_Hwnd" 'changed to be `Public` and keeping the handle
1.a Please copy the next API functions in the same standard module:
#If Win64 Then
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Public Declare PtrSafe Function SetForegroundWindow Lib "user32" _
(ByVal hwnd As LongPtr) As LongPtr
Public Declare PtrSafe Function ShowWindow Lib "user32" _
(ByVal hwnd As LongPtr, ByVal nCmdSHow As Long) As Long
#Else
Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SetForegroundWindow Lib "user32" _
(ByVal hWnd As Long) As Long
Public Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdSHow As Long) As Long
#End If
The above variables are necessary to supply, save and use the necessary window handle (in/from Registry)
Adapt myItem_Open in the next way:
Private Sub myItem_Open(Cancel As Boolean)
EventsDisable = True
If MyItem.Subject = "Auto Plan" And Application.ActiveExplorer.CurrentFolder.Name = "MyTemplate" Then
'Code to maximize the opened outlook email window and set focus for it to be foreground
#If Win64 Then
Dim meHwnd As LongPtr
#Else
Dim meHwnd As Long
#End If
meHwnd = FindWindow(vbNullString, MyItem.GetInspector.Caption) 'find the necessary window handle
SaveSetting MyApp, Sett, wHwnd, CStr(meHwnd) 'memorize it, converted to string
End If
EventsDisable = False
End Sub
3.1 If the mail window must be shown in foreground from VBA of another application, the declarations and API functions from above, must be also copied on top of the module keeping the necessary (following) sub.
3.2 Copy the next adapted Sub and run it (after showing the necessary mail window in Outlook, of course...):
Sub Bring_to_front()
Dim winHwnd As String, i As Long
winHwnd = GetSetting(MyApp, Sett, wHwnd, "No Value")
If winHwnd <> "No Value" Then
#If Win64 Then
Dim mailWindHwnd As LongPtr
mailWindHwnd = CLngPtr(winHwnd)
#Else
Dim mailWindHwnd As Long
mailWindHwnd = CLng(winHwnd)
#End If
SetForegroundWindow mailWindHwnd
ShowWindow mailWindHwnd, 3
End If
End Sub
Please, try it and send some feedback.
I have 4 slides with an ActiveX Label in each of the slides. The first slide contains an ActiveX Command Button.
Private Sub CommandButton1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Set shpPoint = ActivePresentation.SlideShowWindow.View.Slide.Shapes("TextBox 1")
If (KeyCode = vbKeyA) Then
Point = Point + 1
shpPoint.TextFrame.TextRange = Point
End If
End Sub
This code allows me to capture the keypress and run the corresponding macro. To start capturing the keypresses, I would have to first click on the Command Button present in Slide 1. After that, the code does its job wonderfully. However, the code would not work if I go to another slide. The keypress capture occurs only in Slide 1. I assume it has to do with the Private Sub present within Slide1
I'm stuck at replicating the same as I navigate through slides 1 to 4. I do not want to place a command button on every slide. I would like for vbKeyA to be captured across all slides and run the corresponding macro.
Please advise the best method to proceed.
Your approach works because when you click the button for the first time, it gets the focus. As long as the button has the focus, the KeyDown event will trigger. As soon as the button loses focus the event will not trigger anymore. Once you change slide the button on the first slide loses focus.
The comment provided by #DanielDuĊĦek is sensible. Using this approach, you need a control that exposes a KeyDown event in order to trap it and unfortunately you would need such a control to always have the focus, hence one on each slide. Could be a Frame, TextBox, CommandButton etc.
Initial approach - you can skip this section
My initial approach was to try to improve on your approach. Main steps:
At the click of the initial button I've programmatically added a transparent button on each slide using Slide.Shapes.AddOLEObject ClassName:="Forms.CommandButton.1"
I've retrieved each button using the shape returned by AddOLEObject with: Shape.OLEFormat.Object
I added each button in a wrapper class so I can trap the KeyDown events
I edited each button (like making it transparent)
I then added all wrapped buttons to a global collection so I can remove them later.
I encountered 2 issues:
I was not able to programatically set the focus on the transparent buttons (BTW it seems the slide app events are not firing properly - yes, I had a wrapper WithEvents application class as well). Even if this worked the control can still lose focus so it wouldn't be too reliable
The wrapped buttons seemed to lose state (although the global collection had a reference to each) and I could not remove them later
Overall the above approach is horrible and unreliable.
Actual solution
Instead of relying on controls with events I proceeded to hook into the keyboard itself. The following solution will only work on Windows (not on a Mac). As far as I tested it works well.
Drop the following code into a standard module. Call it KeyboardHook:
Option Explicit
'API declarations
#If Mac Then
'No Mac functionality implemented
#Else 'Windows API functionality
#If VBA7 Then
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
#Else
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
#End If
#End If
'Id of the hook procedure to be installed with SetWindowsHookExA for KeyboardProc
Private Const WH_KEYBOARD As Long = 2
'Hook handle returned by SetWindowsHookEx. Used later in UnhookWindowsHookEx
#If VBA7 Then
Private m_hHookKeyboard As LongPtr
#Else
Private m_hHookKeyboard As Long
#End If
'Stored to check if presentation is still running via 'IsPresentationActive'
Private m_presentation As Presentation
Private Const REG_APP As String = "PP"
Private Const REG_SECTION As String = "KeyHook"
Private Const REG_KEY As String = "hHook"
Private Function IsPresentationActive() As Boolean
On Error Resume Next
IsPresentationActive = ActivePresentation.SlideShowWindow.Active
IsPresentationActive = (Err.Number = 0)
On Error GoTo 0
End Function
'*******************************************************************************
'Hooks Keyboard messages
'*******************************************************************************
Public Sub HookKeyboard()
UnHookKeyboard 'Remove previous hook
'
Set m_presentation = ActivePresentation
If Not IsPresentationActive Then Exit Sub
'
Dim isHookSuccessful As Boolean
'
#If Mac Then
#Else
m_hHookKeyboard = SetWindowsHookEx(idHook:=WH_KEYBOARD _
, lpfn:=AddressOf KeyboardProc _
, hmod:=0 _
, dwThreadId:=GetCurrentThreadId())
#End If
If m_hHookKeyboard <> 0 Then
SaveSetting REG_APP, REG_SECTION, REG_KEY, m_hHookKeyboard
Debug.Print "Keyboard hooked " & Now
End If
End Sub
'*******************************************************************************
'UnHooks Keyboard
'*******************************************************************************
Public Sub UnHookKeyboard()
If m_hHookKeyboard = 0 Then 'Try to restore if state was lost
Dim savedHook As String
'
savedHook = GetSetting(REG_APP, REG_SECTION, REG_KEY)
If savedHook <> vbNullString Then
#If VBA7 Then
m_hHookKeyboard = CLngPtr(savedHook)
#Else
m_hHookKeyboard = CLng(savedHook)
#End If
End If
End If
'
If m_hHookKeyboard <> 0 Then
#If Mac Then
#Else
UnhookWindowsHookEx m_hHookKeyboard
#End If
m_hHookKeyboard = 0
DeleteSetting REG_APP, REG_SECTION, REG_KEY
Debug.Print "Keyboard unhooked " & Now
End If
End Sub
'*******************************************************************************
'Callback hook function - monitors keyboard messages
'https://learn.microsoft.com/en-us/previous-versions/windows/desktop/legacy/ms644984(v=vs.85)
'*******************************************************************************
#If Mac Then
#Else
#If VBA7 Then
Private Function KeyboardProc(ByVal ncode As Long _
, ByVal wParam As Long _
, ByVal lParam As Long) As LongPtr
#Else
Private Function KeyboardProc(ByVal ncode As Long _
, ByVal wParam As Long _
, ByVal lParam As Long) As Long
#End If
'nCode
Const HC_ACTION As Long = 0
Const HC_NOREMOVE As Long = 3
'
'WM_KEYUP/DOWN/CHAR HIWORD(lParam) flags
Const KF_EXTENDED = &H100
Const KF_DLGMODE = &H800
Const KF_MENUMODE = &H1000
Const KF_ALTDOWN = &H2000
Const KF_REPEAT = &H4000
Const KF_UP = &H8000
'
If IsVBEActive Then GoTo Unhook 'Unhook if a VBE window is active (to avoid crashes)
If Not IsPresentationActive Then GoTo Unhook
'
If ncode = HC_ACTION Then
If wParam = vbKeyA And (lParam And KF_UP) > 0 Then
Debug.Print "A " & Now
Debug.Print "Shift is down: " & IsShiftKeyDown()
Debug.Print "Ctrl is down: " & IsControlKeyDown()
Debug.Print
'
KeyboardProc = -1
Exit Function
End If
End If
'
NextHook:
KeyboardProc = CallNextHookEx(0, ncode, wParam, ByVal lParam)
Exit Function
Unhook:
UnHookKeyboard
GoTo NextHook
End Function
#End If
'*******************************************************************************
'Get Shift/Control Key State
'https://learn.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-getkeystate
'https://learn.microsoft.com/en-us/windows/desktop/inputdev/virtual-key-codes
'*******************************************************************************
Private Function IsShiftKeyDown() As Boolean
Const VK_SHIFT As Long = &H10
'
IsShiftKeyDown = CBool(GetKeyState(VK_SHIFT) And &H8000) 'hi-order bit only
End Function
Private Function IsControlKeyDown() As Boolean
Const VK_CONTROL As Long = &H11
'
IsControlKeyDown = CBool(GetKeyState(VK_CONTROL) And &H8000)
End Function
'*******************************************************************************
'Returns the String Caption of a Window identified by a handle
'*******************************************************************************
#If VBA7 Then
Private Function GetWindowCaption(ByVal hwnd As LongPtr) As String
#Else
Private Function GetWindowCaption(ByVal hwnd As Long) As String
#End If
Dim bufferLength As Long: bufferLength = GetWindowTextLength(hwnd)
GetWindowCaption = VBA.Space$(bufferLength)
GetWindowText hwnd, GetWindowCaption, bufferLength + 1
End Function
'*******************************************************************************
'Checks if the ActiveWindow is a VBE Window
'*******************************************************************************
Private Function IsVBEActive() As Boolean
#If Mac Then
#Else
IsVBEActive = VBA.InStr(1, GetWindowCaption(GetActiveWindow()) _
, "Microsoft Visual Basic", vbTextCompare) <> 0
#End If
End Function
All you need to do to start tracking key presses is to call the the HookKeyboard method once the presentation has started. You can do that in a few ways. Here are 2:
Press Alt+F8 (Macro Dialog Box) and then run the Macro directly
Use an ActiveX button on the first slide:
Private Sub CommandButton1_Click()
HookKeyboard
End Sub
Important! I've written the code in such a way that it hooks only if the presentation is already started at the moment you call it. Also, it automatically unhooks when the presentation is over (at any key press). If you want to stop the hook before the presentation ends then simply call the UnHookKeyboard method.
Currently, the above code will only display some info in the Immediate Window whenever you press the A key:
All you need to do is to go to the KeyboardProc method and change these lines:
Debug.Print "A " & Now
Debug.Print "Shift is down: " & IsShiftKeyDown()
Debug.Print "Ctrl is down: " & IsControlKeyDown()
Debug.Print
to whatever you need. I suppose you will simply call you desired macro.
I have a userform that opens upon the opening of the workbook. Excel is also hidden so that the userform is all that is shown to the user.
Private Sub Workbook_Open()
Application.Visible = False
UserForm1.Show vbModeless
End Sub
However, this also hides the icon for Excel on the taskbar, so when a user clicks away from the userform they cannot get back into it unless using alt+tab or closes/minimises other windows that are in front of the userform. I do not want the users to do this and some may even try to open the form again (Presuming It is closed), causing re-open prompts and errors that I do not want either.
Essentially, I need an icon on the taskbar for the userform.
Once the userform is closed I have it so that Excel closes
Unload UserForm1
Application.Quit
Examples I have found on the internet for this problem don't quite achieve what I am trying to do.
Changing the form to minimise and open as modal works to keep the icon in the taskbar and not let the user edit the worksheet
Application.WindowState = xlMinimized
UserForm1.Show (1)
But this has 2 problems..... 1st - the userform doesn't become the focus, 2nd - the user can click on the taskbar icon and the sheet is now visible behind the userform, which is not what I what them to be able to do.
I spent an appreciable amount of time on this task in the development of Excel-Visio application and faced with the same problem (Excel form above Visio/ Excel and VBA editor are hidden - but user can lost focus easily and only way back - Alt-Tabbing). Same problem as is!
My algorithm to solve this problem was something like this (All code in Userform class):
Private Sub UserForm_Initialize()
'some init's above
ToggleExcel 'Toggle excel, all windows are hidden now!
ActivateVisio 'Visio fired and on top
SetStandAloneForm 'Let's customize form
End Sub
So on start up we have our desired Visio and Form. On Terminate event I ToggleExcel again and minimize Visio.
ToggleExcel:
Private Function ToggleExcel()
Static IsVBEWasVisible As Boolean
With Application
If .Visible = True Then
IsVBEWasVisible = .VBE.MainWindow.Visible
If IsVBEWasVisible Then _
.VBE.MainWindow.Visible = False
.WindowState = xlMinimized
.Visible = False
Else
If IsVBEWasVisible Then _
.VBE.MainWindow.Visible = True
.WindowState = xlMaximized
.Visible = True
End If
End With
End Function
SetStandAloneForm:
To SetStandAloneForm I declared this block of API-function:
#If VBA7 Then
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
#Else
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow 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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
#End If
Actual SetStandAloneForm:
Private Function SetStandAloneForm()
Const GWL_STYLE As Long = -16
Const GWL_EXSTYLE As Long = -20
Const WS_CAPTION As Long = &HC00000
Const WS_MINIMIZEBOX As Long = &H20000
Const WS_MAXIMIZEBOX As Long = &H10000
Const WS_POPUP As Long = &H80000000
Const WS_VISIBLE As Long = &H10000000
Const WS_EX_DLGMODALFRAME As Long = &H1
Const WS_EX_APPWINDOW As Long = &H40000
Const SW_SHOW As Long = 5
Dim Hwnd As Long
Dim CurrentStyle As Long
Dim NewStyle As Long
If Val(Application.Version) < 9 Then
Hwnd = FindWindow("ThunderXFrame", Me.Caption) 'XL97
Else
Hwnd = FindWindow("ThunderDFrame", Me.Caption) '>XL97
End If
'Let's give to userform minimise and maximise buttons
CurrentStyle = GetWindowLong(Hwnd, GWL_STYLE)
NewStyle = CurrentStyle Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
NewStyle = NewStyle And Not WS_VISIBLE And Not WS_POPUP
Call SetWindowLong(Hwnd, GWL_STYLE, NewStyle)
'Let's give to userform a taskbar icon
CurrentStyle = GetWindowLong(Hwnd, GWL_EXSTYLE)
NewStyle = CurrentStyle Or WS_EX_APPWINDOW
Call SetWindowLong(Hwnd, GWL_EXSTYLE, NewStyle)
Call ShowWindow(Hwnd, SW_SHOW)
End Function
The answer posted by Gareth on this question:
Excel Useform: How to hide application but have icon in the taskbar
Worked to give me a taskbar icon and was a simple copy and paste.
Thanks all for the help.
Rather than hide the application minimise the workbook:
ThisWorkbook.Windows(1).WindowState = xlMinimized
I want that my excel xml always display in full screen view.
For this I code the next:
Private Sub Workbook_Open()
Application.WindowState = xlMaximized
ActiveWindow.WindowState = xlMaximized
Application.DisplayFullScreen = True
End Sub
It is working fine until I minimize excel, once I maximize again It shows in normal view mode, how to proceed? Any suggestion? The main idea is to remove the tool bars as I don't want user to interact with them.
Paste this into the workbook module. It will maximize the windows whenever it gets resized:
Private Sub Workbook_WindowResize(ByVal Wn As Window)
ActiveWindow.WindowState = xlMaximized
End Sub
There is an event that you can trap I'd try adding this to your ThisWorkbook module
Option Explicit
Private mbToggle As Boolean
Private mlPriorState(-1 To 0) As XlWindowState
Private Sub Workbook_WindowResize(ByVal Wn As Window)
mlPriorState(mbToggle) = Wn.WindowState
mbToggle = Not mbToggle
If Wn.WindowState = xlNormal And mlPriorState(mbToggle) <> xlMaximized Then
ActiveWindow.WindowState = xlMaximized
End If
End Sub
Though this may only work on windows that represent the worksheet/workbook. I'd try this first; other solutions involving Windows API are way more complicated.
Folded in some feedback. This code works for me.
Workbook_Activate will bring full screen mode while other will bring back normal mode.
Private Sub Workbook_Activate()
On Error Resume Next
With Application
.DisplayFullScreen = True
.CommandBars("Worksheet Menu Bar").Enabled = False
End With
End Sub
Private Sub Workbook_Deactivate()
On Error Resume Next
With Application
.DisplayFullScreen = False
.CommandBars("Worksheet Menu Bar").Enabled = True
End With
End Sub
EDIT
you shouldn't 'modify' the way Windows works at a system level. However, if you really, really must; add the following to a new module and call the SetStyle procedure.
That code is offered UNTESTED'as is' - the API is a way to modify Windows at a system level and can be dangerous (sudden crashes, data file corruption...) if you do not know what you are doing.
VB:
Option Explicit
'Related Windows API functions
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 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 DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long
'Window style constants
Private Const GWL_STYLE As Long = (-16) '// The offset of a window's style
Private Const GWL_EXSTYLE As Long = (-20) '// The offset of a window's extended style
Private Const WS_CAPTION As Long = &HC00000 '// Title bar bit
Private Const WS_SYSMENU As Long = &H80000 '// System menu bit
Private Const WS_THICKFRAME As Long = &H40000 '// Sizable frame bit
Private Const WS_MINIMIZEBOX As Long = &H20000 '// Minimize box bit
Private Const WS_MAXIMIZEBOX As Long = &H10000 '// Maximize box bit
Private Const WS_EX_TOOLWINDOW As Long = &H80 '// Tool Window: small titlebar bit
'Constant to identify the Close menu item
Private Const SC_CLOSE As Long = &HF060
Public Sub SetStyle()
Dim lStyle As Long, hMenu As Long
'Get the basic window style
lStyle = GetWindowLong(Application.hWnd, GWL_STYLE)
If lStyle = 0 Then
MsgBox "Unable to determine application window handle...", vbExclamation, "Error"
Exit Sub
End If
'// Build up the basic window style flags for the form
'// Uncomment the features you want...
'// Set it True to enable, FALSE to disable
'// The first 2 are obvious, ThickFrame controls if the Window is sizable or not.
'// SetBit lStyle, WS_CAPTION, True
'// SetBit lStyle, WS_SYSMENU, False
'// SetBit lStyle, WS_THICKFRAME, False
SetBit lStyle, WS_MINIMIZEBOX, False
SetBit lStyle, WS_MAXIMIZEBOX, False
'Set the basic window styles
SetWindowLong Application.hWnd, GWL_STYLE, lStyle
'Get the extended window style
lStyle = GetWindowLong(Application.hWnd, GWL_EXSTYLE)
'// Handle the close button differently
'// If Close button is wanted
'// hMenu = GetSystemMenu(Application.hWnd, 1)
'// Not wanted - delete it from the control menu
hMenu = GetSystemMenu(Application.hWnd, 0)
DeleteMenu hMenu, SC_CLOSE, 0&
'Update the window with the changes
DrawMenuBar Application.hWnd
SetFocus Application.hWnd
End Sub
'// Set or clear a bit from a style flag
Private Sub SetBit(ByRef lStyle As Long, ByVal lBit As Long, ByVal bOn As Boolean)
If bOn Then
lStyle = lStyle Or lBit
Else
lStyle = lStyle And Not lBit
End If
End Sub
I need to create a userform for my excel vba program., But how can I add "minimize" button for this userform? Thanks.
You can try this code :
Private Sub ToggleButton1_Click()
If ToggleButton1.Value = True Then
Me.Height = Me.Height * 0.25
Else
Me.Height = dHeight
End If
End Sub
Private Sub UserForm_Initialize()
dHeight = Me.Height
End Sub
[EDIT]
Found this link where they explain how to do it with an API to minimize.
Here is the given code :
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) 'Sets a new window style
Private Const WS_SYSMENU As Long = &H80000 'Windows style
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
'===========================================
'= Originally from Dax =
'= Modified with comments by Ivan F Moala =
'= 22/07/01 =
'===========================================
'Lets find the UserForm Handle the function below retrieves the handle
'to the top-level window whose class name ("ThunderDFrame" for Excel)
'and window name (me.caption or UserformName caption) match the specified strings.
lFormHandle = FindWindow("ThunderDFrame", Me.Caption)
'The GetWindowLong function retrieves information about the specified window.
'The function also retrieves the 32-bit (long) value at the specified offset
'into the extra window memory of a window.
lStyle = GetWindowLong(lFormHandle, GWL_STYLE)
'lStyle is the New window style so lets set it up with the following
lStyle = lStyle Or WS_SYSMENU 'SystemMenu
lStyle = lStyle Or WS_MINIMIZEBOX 'With MinimizeBox
lStyle = lStyle Or WS_MAXIMIZEBOX 'and MaximizeBox
'Now lets set up our New window the SetWindowLong function changes
'the attributes of the specified window , given as lFormHandle,
'GWL_STYLE = New windows style, and our Newly defined style = lStyle
SetWindowLong lFormHandle, GWL_STYLE, (lStyle)
'Remove >'< if you want to show form Maximised
'ShowWindow lFormHandle, SW_SHOWMAXIMIZED 'Shows Form Maximized
'The DrawMenuBar function redraws the menu bar of the specified window.
'We need this as we have changed the menu bar after Windows has created it.
'All we need is the Handle.
DrawMenuBar lFormHandle
End Sub
Regards,
Max
'Place this code in a Module
Private Declare Function FindWindowA Lib "USER32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLongA Lib "USER32" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "USER32" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Option Explicit
Sub FormatUserForm(UserFormCaption As String)
Dim hWnd As Long
Dim exLong As Long
hWnd = FindWindowA(vbNullString, UserFormCaption)
exLong = GetWindowLongA(hWnd, -16)
If (exLong And &H20000) = 0 Then
SetWindowLongA hWnd, -16, exLong Or &H20000
Else
End If
End Sub
Sub ShowForm()
UserForm1.Show
End Sub
'Place this code in a UserForm with one Command Button named CommandButton1.
Option Explicit
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Call FormatUserForm(Me.Caption)
End Sub