Escola Saberexcel VBA Estudos® – Treinamentos com Macros, Fórmulas e Funções
Este Macro do Aplicativo Microsoft Excel VBA(Visual Basic Application), buscar e calcular resolução do Ecran
veja que você poderá chamar um macro dependendo da resolução da tela.
Option Explicit
Private Declare Function GetSystemMetrics Lib “user32” (ByVal nIndex As Long) As Long
‘Constantes utilizadas para GetSystemMetrics
Const SM_CXSCREEN = 0 ‘ Largura da Tela
Const SM_CYSCREEN = 1 ‘ Altura da Tela ‘Ecran
Sub sbx_tamanho()
Dim xValor As Long, yValor As Long
Dim Resolution As String}
‘Dim Zoom As Integer
yValor = GetSystemMetrics(SM_CYSCREEN)
xValor = GetSystemMetrics(SM_CXSCREEN)
Resolution = xValor & ” x ” & yValor
On Error GoTo sbxMensagem
If Resolution = “1280 x 1024” Then ActiveWindow.Zoom = 120
If Resolution = “1400 x 1280” Then ActiveWindow.Zoom = 200
If Resolution = “1400 x 1024” Then ActiveWindow.Zoom = 200
If Resolution = “1280 x 960” Then ActiveWindow.Zoom = 110
‘ If Resolution = “XXXX x XXX” Then ActiveWindow.Zoom = ‘?? <= Se a resolução não está prevista …
If Resolution = “1280 x 720” Then ActiveWindow.Zoom = 90
If Resolution = “1152 x 864” Then ActiveWindow.Zoom = 80
If Resolution = “1024 x 768” Then ActiveWindow.Zoom = 75
If Resolution = “800 x 600” Then ActiveWindow.Zoom = 50
If Resolution = “640 x 480” Then ActiveWindow.Zoom = 30
If Resolution = “1920 x 1080” Then ActiveWindow.Zoom = 100
Exit Sub
sbxMensagem: ‘ caso de erro
MsgBox “Sua tela tem uma resolução de ” & xValor & ” por ” & yValor & _
Chr(10) & “Altere a funçao no macro”, vbInformation, “Macro ‘TAMANHO’ para mudar!”
End Sub
Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos
Escola SaberExcel VBA Estudos® – Treinamentos com Macros, Fórmulas e Funções.
u – Procedimentos de Aquisição dos produtos Didáticos SaberExcel
