Public Sub Test()
 Dim WMI As Object
 Dim Monitors As Object
 Dim Monitor As Object
 Set WMI = GetObject("winMgmts:")
 Set Monitors = WMI.ExecQuery("SELECT * FROM Win32_DesktopMonitor") ' WHERE DeviceID='DesktopMonitor1'")
 For Each Monitor In Monitors
    MsgBox Monitor.PixelsPerXLogicalInch & " x " & Monitor.PixelsPerYLogicalInch & _
           " точек на дюйм", vbInformation, _
           "Логическое разрешение для монитора " & Monitor.Name
 Next
End Sub

Private Enum BOOL
   FALSE_BOOL
   TRUE_BOOL
End Enum

Private Enum DeviceCapabilities
   HORZSIZE = 4           '  Horizontal size in millimeters
   VERTSIZE = 6           '  Vertical size in millimeters
   HORZRES = 8            '  Horizontal width in pixels
   VERTRES = 10           '  Vertical width in pixels
   LOGPIXELSX = 88        '  Logical pixels/inch in X
   LOGPIXELSY = 90        '  Logical pixels/inch in Y
End Enum

#If VBA7 Then
   Private Declare PtrSafe Function CreateIC Lib "gdi32" Alias "CreateICA" ( _
      ByVal lpDriverName As String, ByVal lpDeviceName As String, _
      ByVal lpOutput As String, ByVal lpInitData As String) As LongPtr
   Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hDC As LongPtr) As BOOL
   
   Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" ( _
      ByVal hDC As LongPtr, ByVal nIndex As DeviceCapabilities) As Long
#Else
   Private Declare Function CreateIC Lib "gdi32" Alias "CreateICA" ( _
      ByVal lpDriverName As String, ByVal lpDeviceName As String, _
      ByVal lpOutput As String, ByVal lpInitData As String) As Long
   Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As BOOL

   Private Declare Function GetDeviceCaps Lib "gdi32" ( _
      ByVal hDC As Long, ByVal nIndex As DeviceCapabilities) As Long
#End If

Private Const POINTS_PER_INCH = 72

Public Function PointsPerPixelX() As Double
 #If VBA7 Then
    Dim hicDisplay As LongPtr
 #Else
    Dim hicDisplay As Long
 #End If
 hicDisplay = CreateIC("DISPLAY", vbNullString, vbNullString, vbNullString)
 PointsPerPixelX = POINTS_PER_INCH / GetDeviceCaps(hicDisplay, LOGPIXELSX)
 DeleteDC hicDisplay
End Function

Public Function PointsPerPixelY() As Double
 #If VBA7 Then
    Dim hicDisplay As LongPtr
 #Else
    Dim hicDisplay As Long
 #End If
 hicDisplay = CreateIC("DISPLAY", vbNullString, vbNullString, vbNullString)
 PointsPerPixelY = POINTS_PER_INCH / GetDeviceCaps(hicDisplay, LOGPIXELSY)
 DeleteDC hicDisplay
End Function