Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 24

Thread: Scale display vba code

  1. #1

    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.

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,813
    Location
    Start with SR and Pixels, convert them to Points(?) Top, Left, Height, and Width. Find Ratios and Adjust Form locations.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    you can test this.
    although i don't use scale.
    Attached Files Attached Files
    Last edited by arnelgp; 01-24-2023 at 10:23 PM. Reason: edits

  4. #4
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,286
    Location
    Given that 1 pixel = 0.75 points. 3840 x 2160 pixels is roughly 2880 x 1620 points
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  5. #5
    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%
    Last edited by chubbychub; 01-25-2023 at 02:18 AM.

  6. #6
    after setting the scale to 300%, do you re-start Excel also?

  7. #7
    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.
    Last edited by chubbychub; 01-25-2023 at 10:05 AM.

  8. #8
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    796
    Location
    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

  9. #9
    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)

    userform.jpg

  10. #10
    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.
    Last edited by chubbychub; 01-25-2023 at 04:43 PM.

  11. #11
    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.

  12. #12
    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:

    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

  13. #13
    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

    ' 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

  14. #14
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    796
    Location
    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

  15. #15
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,813
    Location
    Monitor Scaling is a Windows setting. You must look in the Windows "Hive" for that value

    Search the net for "Windows 10 Registry Scale"
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  16. #16
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    796
    Location
    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...
    Private Sub Workbook_Open()
    Call ScreenInfo
    End Sub
    Module 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

  17. #17
    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

  18. #18
    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.

  19. #19
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    796
    Location
    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

  20. #20
    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.

    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •