Boa noite!!
Tente adaptar...
Declare Function GetSystemMetrics32 Lib "user32" _
Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Declare Function GetSystemMetrics16 Lib "user" _
Alias "GetSystemMetrics" (ByVal nIndex As Integer) As Integer
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Sub DisplayVideoInfo()
Dim zmRatio As Variant
On Error Resume Next
If Left(Application.Version, 1) = 5 Then
vidwidth = GetSystemMetrics16(SM_CXSCREEN)
vidHeight = GetSystemMetrics16(SM_CYSCREEN)
Else
vidwidth = GetSystemMetrics32(SM_CXSCREEN)
vidHeight = GetSystemMetrics32(SM_CYSCREEN)
End If
If vidwidth = 800 Then
ActiveWindow.Zoom = 78
ElseIf vidwidth = 1024 Then
ActiveWindow.Zoom = 100
ElseIf vidwidth = 1152 Then
ActiveWindow.Zoom = 111
End If
End Sub
..Ou
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long
Function ScreenResolution() As String
' Returns the PC's Screen Resolution, such as "800x600".
'
' -- Mike_R 2004 0505
Dim lRval As Long
Dim lDc As Long
Dim lHSize As Long
Dim lVSize As Long
Const Resolution_Horz = 8
Const Resolution_Vert = 10
lDc = GetDC(0&)
lHSize = GetDeviceCaps(lDc, Resolution_Horz)
lVSize = GetDeviceCaps(lDc, Resolution_Vert)
lRval = ReleaseDC(0, lDc)
ScreenResolution = CStr(lHSize & "x" & lVSize)
End Function
Postado : 22/08/2012 5:45 pm