Lỗi hiển thị Userform trên các máy tính khác nhau - liên quan tới Screen Scaling

Letuanh2503 · 8/12/22

Em chào admin và các anh chị. Hiện tại em đang gặp vấn đề về Userform như sau:

1. Em có 1 Userform được tạo trên Desktop với đặc điểm: 1920*1080, Desktop Scaling 100%, 24inch

2. Tuy nhiên khi mở trên Laptop: 1920*1080, Screen Scaling 125% thì Userform hiển thị lỗi.
Em thử thay đổi 125% xuống 100% thì Userform hiển thị đúng size trên Laptop. Nhưng bù lại icon, chữ,.. trên laptop nhỏ quá, rất bất tiện ạ.

Vậy có cách nào code VBA khắc phục vấn đề này không ạ? (Code tự thay đổi size Userform dựa trên Screen Scaling)
Em tìm đọc cả tối mà chưa tìm được giải pháp, hầu như chỉ có giải pháp cho việc thay đổi Resolution, còn em đang gặp vấn đề với Screen Scaling ạ
Em cảm ơn admin và anh chị

huhumalu · 9/12/22

PHP:

Option Explicit
'Function to get screen resolution
'https://stackoverflow.com/a/58362904
#If VBA7 Then
    Private Declare PtrSafe Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As LongPtr) As Long
    'Functions to get DPI
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
#Else
    Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
    'Functions to get DPI
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
#End If
Private Const LOGPIXELSX = 88        'Pixels/inch in X
Private Const POINTS_PER_INCH As Long = 72        'A point is defined as 1/72 inches
'Return DPI
'96 – Smaller 100% | 120 – Medium 125% | 144 – Larger 150% |
'192 – Extra Large 200% | 240 – Custom 250% | 288 – Custom 300% |
'384 – Custom 400% | 480 – Custom 500%
Function lDotsPerInch() As Double
    #If VBA7 Then
        Dim hDC     As LongPtr        ' if VBA7
        Dim hWnd    As LongPtr
    #Else
        Dim hDC     As Long
        Dim hWnd    As Long
    #End If
    hDC = GetDC(0)
    lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
    'PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
    ReleaseDC 0, hDC
End Function
Private Sub UserForm_Initialize()
    Dim w           As Long, h As Long
    Dim i           As Integer, PointsPerPixel As Double
    PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
    w = GetSystemMetrics32(0)        ' Screen Resolution width in points
    h = GetSystemMetrics32(1)        ' Screen Resolution height in points
    Debug.Print "Screen Resolution width" & w & " | " & h & " | " & lDotsPerInch
    With Me
        .StartUpPosition = 2
        .Width = w * PointsPerPixel * 0.5        'Userform width= Width in Resolution * DPI * 50%
        .Height = h * PointsPerPixel * 0.5        'Userform height= Height in Resolution * DPI * 50%
    End With
End Sub

Mình có học lóm và sửa lại được code trên. Bạn đưa vào UserForm chạy thử, điều chỉnh theo ý mình nhé.
1. Hàm lDotsPerInch trả về DPI, giá trị tương ứng là

Mã:

'96 – Smaller 100% | 120 – Medium 125% | 144 – Larger 150% |
'192 – Extra Large 200% | 240 – Custom 250% | 288 – Custom 300% |
'384 – Custom 400% | 480 – Custom 500%

2. Sau khi giá trị % Scale họ quy đổi tiếp về PointsPerPixel tương ứng. Sau đó điều chỉnh kích thước của User Form.

Letuanh2503 · 9/12/22

huhumalu đã viết:

PHP:

Option Explicit
'Function to get screen resolution
'https://stackoverflow.com/a/58362904
#If VBA7 Then
    Private Declare PtrSafe Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As LongPtr) As Long
    'Functions to get DPI
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
#Else
    Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
    'Functions to get DPI
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
#End If
Private Const LOGPIXELSX = 88        'Pixels/inch in X
Private Const POINTS_PER_INCH As Long = 72        'A point is defined as 1/72 inches
'Return DPI
'96 – Smaller 100% | 120 – Medium 125% | 144 – Larger 150% |
'192 – Extra Large 200% | 240 – Custom 250% | 288 – Custom 300% |
'384 – Custom 400% | 480 – Custom 500%
Function lDotsPerInch() As Double
    #If VBA7 Then
        Dim hDC     As LongPtr        ' if VBA7
        Dim hWnd    As LongPtr
    #Else
        Dim hDC     As Long
        Dim hWnd    As Long
    #End If
    hDC = GetDC(0)
    lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
    'PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
    ReleaseDC 0, hDC
End Function
Private Sub UserForm_Initialize()
    Dim w           As Long, h As Long
    Dim i           As Integer, PointsPerPixel As Double
    PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
    w = GetSystemMetrics32(0)        ' Screen Resolution width in points
    h = GetSystemMetrics32(1)        ' Screen Resolution height in points
    Debug.Print "Screen Resolution width" & w & " | " & h & " | " & lDotsPerInch
    With Me
        .StartUpPosition = 2
        .Width = w * PointsPerPixel * 0.5        'Userform width= Width in Resolution * DPI * 50%
        .Height = h * PointsPerPixel * 0.5        'Userform height= Height in Resolution * DPI * 50%
    End With
End Sub

Mình có học lóm và sửa lại được code trên. Bạn đưa vào UserForm chạy thử, điều chỉnh theo ý mình nhé.
1. Hàm lDotsPerInch trả về DPI, giá trị tương ứng là

Mã:

'96 – Smaller 100% | 120 – Medium 125% | 144 – Larger 150% |
'192 – Extra Large 200% | 240 – Custom 250% | 288 – Custom 300% |
'384 – Custom 400% | 480 – Custom 500%

2. Sau khi giá trị % Scale họ quy đổi tiếp về PointsPerPixel tương ứng. Sau đó điều chỉnh kích thước của User Form.

Dạ, em cảm ơn anh ạ. Vậy giải pháp là điều chỉnh size của Userform để đáp ứng được độ phân giải và screen scaling tối thiểu anh nhỉ?

UltraExcel · 12/12/22

Bạn dùng Office 2016 trở lên thì giao diện userform tự phóng to theo phân giải màn hình đấy.

Letuanh2503 · 12/12/22

UltraExcel đã viết:
Bạn dùng Office 2016 trở lên thì giao diện userform tự phóng to theo phân giải màn hình đấy.

Không được bác à, em dùng Office 365 luôn

UltraExcel · 13/12/22

Letuanh2503 đã viết:
Không được bác à, em dùng Office 365 luôn

Bạn gửi hình userform máy bnaj lên xem nào?

Letuanh2503 · 13/12/22

UltraExcel đã viết:
Bạn gửi hình userform máy bnaj lên xem nào?

Em gửi anh link ạ:

Liên kết: https://youtu.be/vTxeKI0CMXQ

UltraExcel · 13/12/22

Letuanh2503 đã viết:
Em gửi anh link ạ:

Liên kết: https://youtu.be/vTxeKI0CMXQ

Mình thấy các phần mềm thiết kế họ không lấy 1920 làm tiêu chuẩn độ rộng màn hình mà lấy độ rộng nhỏ hơn để phù hợp với đa số màn hình máy tính khác.

Letuanh2503 · 13/12/22

UltraExcel đã viết:
Mình thấy các phần mềm thiết kế họ không lấy 1920 làm tiêu chuẩn độ rộng màn hình mà lấy độ rộng nhỏ hơn để phù hợp với đa số màn hình máy tính khác.

Vấn đề của em không phải vậy anh ạ! Anh đang hiểu sai vấn đề của em rồi. Cảm ơn anh

Lỗi hiển thị Userform trên các máy tính khác nhau - liên quan tới Screen Scaling

Letuanh2503

Thành viên mới

File đính kèm

huhumalu

Thành viên tiêu biểu

Letuanh2503

Thành viên mới

UltraExcel

Thành viên chính thức

Letuanh2503

Thành viên mới

UltraExcel

Thành viên chính thức

Letuanh2503

Thành viên mới

UltraExcel

Thành viên chính thức

Letuanh2503

Thành viên mới

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng