Resolução de monitor

Ok, segue toda a rotina:

No SubMain

Option Explicit
Dim xTwips As Long
Dim yTwips As Long
Dim xPixels As Long
Dim yPixels As Long
Private Sub Form_Load()
If App.PrevInstance Then
MsgBox App.EXEName + " Programa Já Está Sendo Executado ", vbCritical, "Atenção Erro"
End
End If
xTwips = Screen.TwipsPerPixelX
yTwips = Screen.TwipsPerPixelY
yPixels = Screen.Height / yTwips
xPixels = Screen.Width / xTwips
lHEIGHT = (yPixels / 600)
lWIDTH = (xPixels / 800)

' Para Alterar Resolução

' If xPixels <> 800 Or yPixels <> 600 Then
' sMEN = MsgBox("A Resolução da Tela é: " & Str$(xPixels) & " por " + Str$(yPixels) & ". O tamanho da tela não ficará adequado. Deseja Alterar?", vbQuestion + vbYesNo, "Resolução de Video")
' If sMEN = vbYes Then
' Call ChangeRes(800, 600)
' End If
' End If

End Sub

' Para chamar de qualquer Form

Private Sub Form_Load()

Me.Top = (2030 * lHEIGHT)
Me.Left = (2300 * lWIDTH)
Me.Height = (6000 * lHEIGHT)
Me.Width = (6795 * lWIDTH)
Set sRESIZE = Me

TAMANHO

End Sub

Em um módulo

Public sCONTROL As String

Public lHEIGHT As Long

Public lWIDTH As Long

Public sRESIZE As Form

Public oOBJ as Object

Public Function TAMANHO()
Dim sSTR As String
Dim I As Integer
Dim nCOL As Column
If lHEIGHT <> 1 Then
For Each oOBJ In sRESIZE.Controls
   sCONTROL = oOBJ.Name
   sSTR = UCase$(Left(sCONTROL, 3))
   If sSTR <> "MNU" Then       ' se for Menu
    If sSTR <> "STE" Then        ' Linha de Divisão de Menu
     If sSTR <> "TMR" Then      ' Timer
      If sSTR <> "DTA" Then     ' Controle Data
       If oOBJ.Top >= 70 Then
        oOBJ.Top = (oOBJ.Top * lWIDTH)
       End If
       If oOBJ.Left >= 70 Then
        oOBJ.Left = (oOBJ.Left * lHEIGHT)
       End If
       If sSTR <> "LBL" And sSTR <> "LAB" And sSTR <> "TXT" And sSTR <> "TEX" And sSTR <> "CBO" And sSTR <> "DRI" And sSTR <> "DTP" Then

        ' controles que não aceitam a propriedade
        oOBJ.Height = (oOBJ.Height * lHEIGHT)
       End If
       If sSTR <> "PIC" Then    ' picture
        oOBJ.Width = (oOBJ.Width * lWIDTH)
       End If
       If sSTR = "DBG" Then     ' DbGrid
        I = 0
        For Each nCOL In oOBJ.Columns
         nCOL.Width = oOBJ.Columns(I).Width
         oOBJ.Columns(I).Width = (nCOL.Width * lWIDTH)
         I = I + 1
        Next
       End If
      End If
     End If
    End If
   End If
Next
End If
End Function

Bom, veja se consegue entender, é isto ai, tem dado certo, pequenas distorções imperceptiveis.

vlu//