Fullscreen userform - not working for everyone?

behedwin

Active Member
Joined
Dec 10, 2014
Messages
399
Hi

I am using this code to run my userform in fullscreen.
I have 7 ppl using the document and it works for all but 1.

Code:
Sub Fullscreen()
'fullscreen för userform

    Dim lngWinState As XlWindowState

    With Application
        .ScreenUpdating = False
        lngWinState = .WindowState
        .WindowState = xlMaximized
        Personalform.Move 0, 0, .Width, .Height
        .WindowState = lngWinState
        .ScreenUpdating = True
    End With
End Sub

For everyone it works fine, the userform is stretched to fit the users screen.
But for one it is stretched to much and the user cant see some of the objects on the userform because they are outside of the screen.


Why is this?

Is there some method to ensure that a userform is stretched "better" on all screens?
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
Hi

I am using this code to run my userform in fullscreen.
I have 7 ppl using the document and it works for all but 1.

Code:
Sub Fullscreen()
'fullscreen för userform

    Dim lngWinState As XlWindowState

    With Application
        .ScreenUpdating = False
        lngWinState = .WindowState
        .WindowState = xlMaximized
        Personalform.Move 0, 0, .Width, .Height
        .WindowState = lngWinState
        .ScreenUpdating = True
    End With
End Sub

For everyone it works fine, the userform is stretched to fit the users screen.
But for one it is stretched to much and the user cant see some of the objects on the userform because they are outside of the screen.


Why is this?

Is there some method to ensure that a userform is stretched "better" on all screens?

I am interested in this. I tried it and it left only the close button. What did I do wrongly?
Regards
Kelly
 
Upvote 0
I am interested in this. I tried it and it left only the close button. What did I do wrongly?
Regards
Kelly

I dont know, im not an expert at VBA so i am guessing allot...
But i use above code in a module and then call it on a userform activate sub.
Then the userform opens in fullscreen mode.
 
Upvote 0
Give this a try :

Place the code in the UserForm Module:

Code:
Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    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 Long
    Private Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private hwnd As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex 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 IsWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private hwnd As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1

Private Sub UserForm_Initialize()
    Call WindowFromAccessibleObject(Me, hwnd)
    If IsWindow(hwnd) Then
        SetWindowPos hwnd, 0, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN), 0
    End If
End Sub
 
Upvote 0
Hello Mr. Jaafaer
We have missed you a lot ..
I have tried the code but the userform is the same (I expect it to be fit screen). I am using windows 7 32 Bit and office 2016 32 Bit
We are waiting for you at this link From Here
 
Upvote 0
Give this a try :

Place the code in the UserForm Module:

Code:
Option Explicit

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    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 Long
    Private Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private hwnd As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex 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 IsWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private hwnd As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1

Private Sub UserForm_Initialize()
    Call WindowFromAccessibleObject(Me, hwnd)
    If IsWindow(hwnd) Then
        SetWindowPos hwnd, 0, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN), 0
    End If
End Sub

I placed this code in a new module

and then called the "userform_initialize sub when userform is activated.
First i got an error on this row: Call WindowFromAccessibleObject(Me, hwnd)

so i changed ME to the name of my userform.

this fixed the error
but nothing happens when i run the code.

and i have to remove "private" from the sub name since it cant be initiated when it is private.
 
Last edited:
Upvote 0
Give this a try :

Place the code in the UserForm Module:

Code:
Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    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 Long
    Private Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private hwnd As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else][URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] [/URL] 
    Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex 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 IsWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private hwnd As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1

Private Sub UserForm_Initialize()
    Call WindowFromAccessibleObject(Me, hwnd)
    If IsWindow(hwnd) Then
        SetWindowPos hwnd, 0, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN), 0
    End If
End Sub

all the lines under the #Else are highlighted red. I am asked to update it to suit the 64 bit system. What should I do?
Thanks
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top