Notifications
Clear all

Ajustar a userform e todos os objetivos conforme resolução

9 Posts
4 Usuários
0 Reactions
2,033 Visualizações
Lorenzon
(@lorenzon)
Posts: 355
Reputable Member
Topic starter
 

Pessoal, bom dia!

É o seguinte, ao executar o meu projeto, a resolução do monitor, independente de qual for, passar a ser de 1280 x 768. O que acontece é que desejo utilizá-la no netbook, mas a resolução máxima deste net é menor que esta.

Por este motivo, a useform e os seus objetivos não ficam enquadrados no monitor.

Existe algum código que ajuste toda a userform e todos os objetos nela contida de acordo com a resolução atual do monitor?

 
Postado : 28/02/2014 8:16 am
Basole
(@basole)
Posts: 487
Reputable Member
 

Olá Lorenzon,

Para este caso, minha sugestão seria formulário maximizado:

http://1.bp.blogspot.com/-1w7VgJCLzug/UNwypaP1BeI/AAAAAAAAAJk/iXeuNfxPaUU/s320/form_maxi.JPG

Em uma Classe, ponha esta macro:

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
    
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long) As Long
    
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
    
Private Declare Function GetSystemMenu Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal bRevert As Long) As Long
    
Private Declare Function DeleteMenu Lib "user32" ( _
    ByVal hMenu As Long, _
    ByVal nPosition As Long, _
    ByVal wFlags As Long) As Long
    
Private Declare Function ShowWindow Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal nCmdShow As Long) As Long
    
Private Declare Function EnableWindow Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal fEnable As Long) As Long

Private Declare Function DrawMenuBar Lib "user32" ( _
    ByVal hWnd As Long) As Long

Private Declare Function SetFocus Lib "user32" ( _
    ByVal hWnd As Long) As Long

Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" ( _
    ByVal hInst As Long, _
    ByVal lpszExeFileName As String, _
    ByVal nIconIndex As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Integer, _
    ByVal lParam As Long) As Long

Private Const GWL_STYLE As Long = (-16)
Private Const GWL_EXSTYLE As Long = (-20)
Private Const WS_CAPTION As Long = &HC00000             '************************************************'
Private Const WS_SYSMENU As Long = &H80000              'UTILIZAÇÃO DAS APIS DO WINDOWS PARA CRIAÇÃO DOS
Private Const WS_THICKFRAME As Long = &H40000           'BOTÕES DO FORMULÁRIO
Private Const WS_MINIMIZEBOX As Long = &H20000          '*********************************************'
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const WS_POPUP As Long = &H80000000
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_EX_DLGMODALFRAME As Long = &H1         '*********************************************'
Private Const WS_EX_APPWINDOW As Long = &H40000         'DEFINIÇÃO DE TAMANHO , ESTILO , COR E POSIÇÃO DOS
Private Const WS_EX_TOOLWINDOW As Long = &H80           'BOTÕES DO FORMULÁRIO
                                                        '************************************************'
Private Const SC_CLOSE As Long = &HF060
Private Const SW_HIDE As Long = 0
Private Const SW_SHOW As Long = 3
Private Const WM_SETICON = &H80

Dim hWndForm As Long
Dim mbSizeable As Boolean
Dim mbCaption As Boolean
Dim mbIcon As Boolean
Dim miModal As Integer
Dim mbMaximize As Boolean
Dim mbMinimize As Boolean
Dim mbSysMenu As Boolean
Dim mbCloseBtn As Boolean
Dim mbAppWindow As Boolean
Dim mbToolWindow As Boolean
Dim msIconPath As String
Dim moForm As Object

Public Property Set Form(oForm As Object)
    
    If Val(Application.Version) < 9 Then
        hWndForm = FindWindow("ThunderXFrame", oForm.Caption)  'XL97
    Else
        hWndForm = FindWindow("ThunderDFrame", oForm.Caption)  'XL2000
    End If
    Set moForm = oForm
    AtualizarEstiloForm
    
End Property

Private Sub AtualizarEstiloForm()
    
    Dim iStyle As Long
    Dim hMenu As Long
    Dim hID As Long
    Dim iItems As Integer
    
    If hWndForm = 0 Then Exit Sub
        iStyle = GetWindowLong(hWndForm, GWL_STYLE)
        iStyle = iStyle Or WS_CAPTION
        iStyle = iStyle Or WS_SYSMENU
        iStyle = iStyle Or WS_THICKFRAME
        iStyle = iStyle Or WS_MINIMIZEBOX
        iStyle = iStyle Or WS_MAXIMIZEBOX
        iStyle = iStyle And Not WS_VISIBLE And Not WS_POPUP
        SetWindowLong hWndForm, GWL_STYLE, iStyle
        iStyle = GetWindowLong(hWndForm, GWL_EXSTYLE)
        iStyle = iStyle And Not WS_EX_DLGMODALFRAME
        iStyle = iStyle Or WS_EX_APPWINDOW
    
    SetWindowLong hWndForm, GWL_EXSTYLE, iStyle
    hMenu = GetSystemMenu(hWndForm, 0)
    
    ShowWindow hWndForm, SW_SHOW
    DrawMenuBar hWndForm
    SetFocus hWndForm

End Sub

No formulário, ponha esta macro:

Option Explicit

'ATIVAÇÃO DA CLASSE DO FORMULÁRIO
Dim nAtualizaForm As New Classe1
Private Sub UserForm_Activate()
    Set nAtualizaForm.Form = Me
End Sub

Espero ter ajudado

Click em se a resposta foi util!

 
Postado : 28/02/2014 11:41 am
Lorenzon
(@lorenzon)
Posts: 355
Reputable Member
Topic starter
 

Olá Basole,

Eu até inseri os códigos como sugerido por você, não ocorreu nenhum erro, mas também nada mudou.

Para testa-lo, eu mudei a resolução do meu computador para 800 x 600, mas a userform e seus objetos não se enquadraram a tal resolução.

Vide print abaixo:

 
Postado : 28/02/2014 12:12 pm
Basole
(@basole)
Posts: 487
Reputable Member
 

Lorenzon,

Na verdade este codigo, tenho guardado na minha coleção, mas nunca tive oportunidade de usa-lo.
Mas qto. ao funcionamento, verifique se voce renomeou a classe que voce criou, para (de acordo com o código), como: "Classe1"

Click em se a resposta foi util!

 
Postado : 28/02/2014 12:25 pm
Basole
(@basole)
Posts: 487
Reputable Member
 

Boa noite Lorenzon,

Fiz um teste com o codigo para formulário maximizado e funcionou pefeitamente.

Segue exemplo.

Click em se a resposta foi util!

 
Postado : 28/02/2014 7:09 pm
Lorenzon
(@lorenzon)
Posts: 355
Reputable Member
Topic starter
 

Basole,

O que preciso é que, independente da resolução que o monitor estiver, a planilha, os textbox e todos os outros botões e comandos se adaptem a ela.

Na imagem abaixo eu coloquei a resolução do computador em 800 x 600, mas a listbox e os demais objetos não se ajustaram a tal resolução.

 
Postado : 04/03/2014 1:53 pm
Basole
(@basole)
Posts: 487
Reputable Member
 

Boa noite Lorenzon,

Veja este exemplo se te atende, que redimensiona o userform, textbox, imagem botao etc.

http://www.sendspace.com/file/yr9tsw

Click em se a resposta foi util!

 
Postado : 04/03/2014 4:10 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Aproveitando o modelo do Basole, só que com outro tipo de rotina para maximizar um form e seus controles, veja se é isto o que quer.

Form FullScreen

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 04/03/2014 4:31 pm
(@nightclub)
Posts: 1
New Member
 

Boa tarde mauro, pode postar seu exemplo novamente, estou com o mesmo problema

 
Postado : 16/01/2015 9:54 am