-
Scale display vba code
I have different display Scale level, some monitors at 100%, other s at 200%, others at 175%, others at 300 %, and userform dont display when the userform is set on the bottom of the excel sheet, (the resolution on this screen are the same at 3840 x2160 on all the screens but not SCALE)
i dont want the userform to appear in the middle, if there was a code to obtain the SCALE level , then i can put a vba code to position the userform according to scale level with a IF and else statement to position the userform accordingly. If someone can help me to code in vba about obtaining windows 11 scale level with 64bit excel 2019 please.
P.D. I have google for a couple of days and all vba code that i have found is regarding screen resolution and pixels.
-
Start with SR and Pixels, convert them to Points(?) Top, Left, Height, and Width. Find Ratios and Adjust Form locations.
-
1 Attachment(s)
you can test this.
although i don't use scale.
-
Given that 1 pixel = 0.75 points. 3840 x 2160 pixels is roughly 2880 x 1620 points
-
thank you all for the replies, however , how will the file on post 2 or the other suggestions be able to tell a resolution screen 3840 x2160 at scale 100% from a screen resolution of 3840 x2160 at a scale of 300% ? because it appears way off screen at 300%
-
after setting the scale to 300%, do you re-start Excel also?
-
these are different computers screen so all the monitors have the same resolution but not the scale so they always start at resolution 3840 x2160 at 100%, another screen 3840x2160 at 175%, anotehr screen at 3840x2160 at 300%, another screen at 3840x2160 at 475%
so i was testing to detect resolution screen and put a if and else statement, but dont work, since they are the same resolution, but the scale is different. so if there was a way to detect or differentiate the scale factor from windows 11.
i mean these computers are for different purposes for designs, but they all use the same userform for quoting price.
-
arnelgo seemed to have missed some code in the attached wb but did include a link to this..
https://forum.ozgrid.com/forum/index...en-resolution/
which works quite well and does adjust the forms for zoom (DPI). You may need to adjust the API's for 64bit use. Your next difficulty will be adjusting the controls on the form to resize and reposition with the change in the form size. HTH. Dave
-
1 Attachment(s)
no, the DPI is for printing, the screen all have the same resolution but the level of zoom is different and that needs to be detected, not the DPI. attached i have posted a picture at 100% scale with 3840 x2160 which is positioned exactly on where i want it. BUT, at another screen of 300% with resolution of 3840x2160..(same) but at a 300% scale, the Userform dont even appear on the screen (and cant see it so not clickable)
Attachment 30475
-
I really think i am out of luck, i have been googling for weeks on finding a way to get scale level, and cant seem to find anything to get it from windows 11. or if someone can kindly point a finger on where to look around please, will appreciated and thank you for reading.
I mean to simplify things, but just not possible, i can adjust display all at standard zoom but some screen are on walls and far to see so hence on 8K monitors, its needs 400% zoom level to be view.
-
did you test the workbook i upload on all those pc (with diiferent zoom level).
in my opinion, it will work for whaever zoom level.
if Excel is displayed "normal" to all zoom level (on all pc's), then it should work
since it uses the Excel size (on current zoom level) to position the userform.
note, i never tried it on "shared" workbook.
-
yes i tried it, but didnt work at the 300%. Excel is not displayed normal, its only half of the top excel part is displayed, so when the userform apppears, it will be on the bottom (which is off screen).
so my idea was to put a if and else statement by detecting scale level somethihng like this:
Code:
if windows scale level is 300%, then userform position at middle screen
if windows scale level is 200% , then userform position at bottom of screen
if windows scale level at 100%, then appear on top of screen
obiously in vba language, but i havent figure that out yet
-
you check this forum for the scale:
DPI-related APIs and registry settings | Microsoft Learn
the value in:
HKCU\Control Panel\Desktop\LogPixels
and using Code in:
Find registry key using Excel VBA - Stack Overflow
Code:
' https://stackoverflow.com/questions/35936735/find-registry-key-using-excel-vba
Private Sub test()
Dim key As String
Dim objShell As Object
Set objShell = CreateObject("WScript.Shell")
key = objShell.RegRead("HKCU\Control Panel\Desktop\LogPixels")
Debug.Print Val(key)
If Len(key) Then
Debug.Print "Scale: " & FormatPercent(Val(key) / 96, 0)
End If
End Sub
-
How to build high DPI aware native Windows desktop applications (mariusbancila.ro)
The link explains what the problem is and why previous DPI measurements always return 96.... the native DPI rather than the effective DPI created by scaling. After a certain version of Windows 10, you need to change API code previously used to determine and then adjust scale factors. The link offers some C+ code(I think?) to make the adjustments you need but I don't know how to adapt them into API code that you could use. My Windows 11 version won't let me use the above RegRead code and it seems the DPI value is at HKCU\Control Panel\Desktop\PerMonitorSettings Anyways, if anyone has the new API's needed (GetDpiForMonitor / GetDpiForWindow/
GetSystemMetricsForDpi) it sure would be helpful. HTH. Dave
-
Monitor Scaling is a Windows setting. You must look in the Windows "Hive" for that value
Search the net for "Windows 10 Registry Scale"
-
Not exactly sure if this will fix your userform placement problem and I also suspect that you will need to re-size your userform and controls but this code might help. The API's will provide you the screen resolution and scale factor being used. The code also adjusts the XL zoom based on the scale factor which MAY solve your placement problem. It does nothing to adjust your userform and controls size(s). Also, I found a couple of the new API's which I included that can also be used to provide the scale (which for some reason is slightly different than the previous method?). The wb needs to be opened after changes to the screen appearance so it seems using a wb open event is best to run the code. HTH. Dave
workbook code...
Code:
Private Sub Workbook_Open()
Call ScreenInfo
End Sub
Module code...
Code:
#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
Public Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Dim hdcScreen As LongPtr
#Else
Dim hdcScreen As Long
Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
#End If
Public Declare PtrSafe Function GetDpiForWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare PtrSafe Function GetSystemMetricsForDpi Lib "user32" (ByVal nIdx As Long, ByVal lDPI As Long) As Long
Public Const LOGPIXELSX = 88 'Pixels/inch in X
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Public X As Long
Public Y As Long
Public Function GetDpi() As Long
Dim iDPI As Long
iDPI = -1
hdcScreen = GetDC(0)
If (hdcScreen) Then
iDPI = GetDeviceCaps(hdcScreen, LOGPIXELSX)
ReleaseDC 0, hdcScreen
End If
GetDpi = iDPI
End Function
Sub ScreenInfo()
Dim DPIScale As Double, DPIScale2 As Double
X = GetSystemMetrics(SM_CXSCREEN)
Y = GetSystemMetrics(SM_CYSCREEN)
DPIScale = GetDpi
If DPIScale <> 96 Then
DPIScale = (1 + ((DPIScale - 96) / 96)) * 100
Else
DPIScale = 100
End If
MsgBox "Screen Resolution: " & X & " x " & Y & vbCrLf _
& "Scale: " & DPIScale & "%"
Call ScreenResToZoom(DPIScale)
'trial GetSystemMetricsForDpi
'DPIScale2 = GetSystemMetricsForDpi(2, GetDpi)
'If DPIScale2 <> 17 Then
'DPIScale2 = (1 + ((DPIScale2 - 17) / 17)) * 100
'Else
'DPIScale2 = 100
'End If
'MsgBox "DPIScale using GetSystemMetricsForDpi: " & DPIScale2 & "%"
End Sub
Public Function ScreenResToZoom(DPIScaler As Double)
Select Case DPIScaler
Case Is = 100
ScreenResToZoom = 100
Case Is = 125
ScreenResToZoom = 95
Case Is = 150
ScreenResToZoom = 85
Case Is = 175
ScreenResToZoom = 70
Case Else
ScreenResToZoom = 50
End Select
ActiveWindow.Zoom = ScreenResToZoom
End Function
-
Dave It detects the scale level your code!!!! i need to make adjustments in the posistioning and going to test some more but was so excited and came here to post first. I will post results! but so far it its able to detect the scale!!
PD. Thank you all for the replies, i have been googling and found this but its in C + languague..i think
https://github.com/lihas/windows-DPI...ster/README.md
-
where do i insert a IF and else statement in that code?
for example,
if scale zoom is between 150% to 200% , then userform appear at (x,y) position
if scale zoom is between 201% to 300%, then userform appear at (x+300, y+300) position
if scale zoom is between 301% to 400%, then userform appear at (x+600, y+600) position
if scale zoom is between 401% to 500%, then userform appear at (x+800, y+800) position
PD, those aint the real coordinates, just trying to get an idea on where to put that code than i will adjust the coordinates.
-
The "ScreenResToZoom" function is set to receive the scale and is also set up for a multiple conditions with a Case statement that can be adapted for your use. Dave
-
i dont know how to code vba at all
from just googling but get alot of compilation error, if anyone can correct the code i post please. apologies, is not my lack of effort, its my lack of knowledge and google cant help me.
Code:
Public Function ScreenResToZoom(DPIScaler As Double)
Select Case DPIScaler
Case Is = >100 to 200
ScreenResToZoom = 100
then Me.Top = (Application.Height - 75 - Me.Height)
Case Is = >201 to 300
ScreenResToZoom = 95
then Me.Top = (Application.Height - 100 - Me.Height)
Case Is = >301 to 400
ScreenResToZoom = 85
then Me.Top = (Application.Height - 125 - Me.Height)
Case Is = >401 to 500
ScreenResToZoom = 70
then Me.Top = (Application.Height - 150 - Me.Height)
Case Else
ScreenResToZoom = 50
then Me.Top = (Application.Height - 75 - Me.Height)
End Select
ActiveWindow.Zoom = ScreenResToZoom
End Function