Vídeo recomendado
https://youtu.be/diWPPPhW-9E

AJUSTE AUTOMÁTICO DE USERFORM A RESOLUÇÃO TELAS DESCONHECIDA

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
Avatar do usuário
Mikel Silveira Fraga
Jedi
Jedi
Mensagens: 1173
Registrado em: Sex Mai 27, 2011 3:27 pm
Localização: Governador Valadares - MG
Contato:

Re: AJUSTE AUTOMÁTICO DE USERFORM A RESOLUÇÃO TELAS DESCONHECIDA

Mensagem por Mikel Silveira Fraga »

Rafael e Srobles, boa noite.

Quando procurei sobre o assunto, na verdade estava buscando o artigo que falava sobre esse Archor Control, mas durante o dia fico meio limitado em minhas pesquisas.

Esse arquivo usa uma Classe que funciona perfeitamente.

Se não me engano, já vi algo aqui no fórum também, mas quando busquei, não localizei mais.

Esse modelo, se bem adaptado, fica simplesmente incrível.

Vou aproveitar e buscar pelo artigo, pois estou estruturando umas classes que vai precisar desse nosso amigo.

Abraços e boa noite.


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
Mikel Silveira Fraga
Jedi
Jedi
Mensagens: 1173
Registrado em: Sex Mai 27, 2011 3:27 pm
Localização: Governador Valadares - MG
Contato:

Re: AJUSTE AUTOMÁTICO DE USERFORM A RESOLUÇÃO TELAS DESCONHECIDA

Mensagem por Mikel Silveira Fraga »

srobles escreveu: Qui Out 26, 2017 4:18 pm O Jedi abaixo do nome não está ali á toa!
Srobles, boa noite.

Cara, o verdadeiro Jedi é o Tomás. Eu ainda estou em treinamento.

Se cuida e sempre estamos aqui, estudando e aprendendo mais.

Abraços!!!!!


srobles
Jedi
Jedi
Mensagens: 805
Registrado em: Qua Mai 06, 2015 7:39 pm

Re: AJUSTE AUTOMÁTICO DE USERFORM A RESOLUÇÃO TELAS DESCONHECIDA

Mensagem por srobles »

Grande Mikel!

Confesso que até o momento não me deparei com uma situação ou projeto que precisasse dessas propriedades, mas agora, sabendo disso, me abriu um leque enorme de idéias.

Ambos os modelos disponibilizados são excelentes, o que me faz "insistir no erro" com relação ao uso do VBA.

Agradeço imensamente por poder participar deste fórum e de poder contar com pessoas como você, Tomás, Reinaldo, JoseA e muitos outros, que mesmo não conhecendo muitos dos usuários, não hesitam em ajudar e mais além, em transmitir seus conhecimentos aos demais.

Mikel, não seja modesto meu amigo. É JEDI e ponto final. :lol:

Lembrando apenas, que nunca saberemos de tudo, 100% do tempo. Cada dia, um novo aprendizado, cada dia, um novo desafio.

Enfim, assim como você e os demais citados acima, têm completo domínio dos assuntos tratados aqui no fórum, e mais ainda, domínio na arte de ensinar.

Mais uma vez, obrigado á todos.

Abs


RAFAEL AMORIM
Colaborador
Colaborador
Mensagens: 69
Registrado em: Sáb Jul 22, 2017 10:17 am

Re: AJUSTE AUTOMÁTICO DE USERFORM A RESOLUÇÃO TELAS DESCONHECIDA

Mensagem por RAFAEL AMORIM »

Meus caros amigos: srobles, Mikel Silveira Fraga
Não pude deixar de compartilhar esse arquivo!
O projeto anteriormente compartilhado realmente era incrível,porém bem extenso e difícil de ajustar às necessidades subjetivas (principalmente se for um calouro em vba, como eu!); encontrei esse código abaixo e realmente é muito massa! Ele possibilita um redimensionamento em qualquer direção com autoajuste de todos os controles de formulário.
Analisem é incrível mesmo!

Código: Selecionar todos

 - No módulo

Option Explicit

Declare PtrSafe Function FindWindowA& Lib "User32" (ByVal lpClassName$, ByVal lpWindowName$)
Declare PtrSafe Function GetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&)
Declare PtrSafe Function SetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)


' Déclaration des constantes
Public Const GWL_STYLE As Long = -16
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_FULLSIZING = &H70000

'Attention, envoyer après changement du caption de l'UF
Public Sub InitMaxMin(mCaption As String, Optional Max As Boolean = True, Optional Min As Boolean = True, Optional Sizing As Boolean = True)
Dim hWnd As Long
    hWnd = FindWindowA(vbNullString, mCaption)
    If Max Then SetWindowLongA hWnd, GWL_STYLE, GetWindowLongA(hWnd, GWL_STYLE) Or WS_MAXIMIZEBOX
    If Min Then SetWindowLongA hWnd, GWL_STYLE, GetWindowLongA(hWnd, GWL_STYLE) Or WS_MINIMIZEBOX
    If Sizing Then SetWindowLongA hWnd, GWL_STYLE, GetWindowLongA(hWnd, GWL_STYLE) Or WS_FULLSIZING
End Sub

Código: Selecionar todos


Option Explicit

Dim Lg As Single
Dim Ht As Single
Dim Fini As Boolean


Private Sub UserForm_Initialize()
Dim i As Integer, L As Integer, TB

    InitMaxMin Me.Caption
    Ht = Me.Height
    Lg = Me.Width

End Sub


Private Sub UserForm_Resize()
    Dim RtL As Single, RtH As Single
        If Me.Width < 300 Or Me.Height < 200 Or Fini Then Exit Sub
        RtL = Me.Width / Lg
        RtH = Me.Height / Ht
        Me.Zoom = IIf(RtL < RtH, RtL, RtH) * 100
End Sub


Private Sub UserForm_Terminate()
    Fini = True
End Sub
Anexos
Minimizar e Maximizar form.rar
(53.3 KiB) Baixado 492 vezes


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


paulovarjal
Acabou de chegar
Acabou de chegar
Mensagens: 1
Registrado em: Qui Jan 25, 2018 9:10 pm

Re: AJUSTE AUTOMÁTICO DE USERFORM A RESOLUÇÃO TELAS DESCONHECIDA

Mensagem por paulovarjal »

TOP. realmente funciona... Testei em diferentes resoluções no excel 2016

Preciso apenas de um pequeno ajuste...

Queria tirar os botões minimizar, maximizar e fechar... quero que o formulário inicie maximizado...

Acredito que isso seja simples, mas sou iniciante e não sei como fazer...

Grato,


Basole
Colaborador
Colaborador
Mensagens: 67
Registrado em: Qua Mar 20, 2013 6:31 pm

Re: AJUSTE AUTOMÁTICO DE USERFORM A RESOLUÇÃO TELAS DESCONHECIDA

Mensagem por Basole »

Sim, veja se é isso que precisa.
Anexos
Minimizar e Maximizar form-Sem Botoes.zip
(57.18 KiB) Baixado 430 vezes


Avatar do usuário
Alex Abreu
Colaborador
Colaborador
Mensagens: 31
Registrado em: Sáb Jun 30, 2018 4:40 pm
Localização: Rio do Campo/SC
Contato:

Re: AJUSTE AUTOMÁTICO DE USERFORM A RESOLUÇÃO TELAS DESCONHECIDA

Mensagem por Alex Abreu »

RAFAEL AMORIM escreveu: Seg Out 30, 2017 4:06 pm Meus caros amigos: srobles, Mikel Silveira Fraga
Não pude deixar de compartilhar esse arquivo!
O projeto anteriormente compartilhado realmente era incrível,porém bem extenso e difícil de ajustar às necessidades subjetivas (principalmente se for um calouro em vba, como eu!); encontrei esse código abaixo e realmente é muito massa! Ele possibilita um redimensionamento em qualquer direção com autoajuste de todos os controles de formulário.
Analisem é incrível mesmo!

Código: Selecionar todos

 - No módulo

Option Explicit

Declare PtrSafe Function FindWindowA& Lib "User32" (ByVal lpClassName$, ByVal lpWindowName$)
Declare PtrSafe Function GetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&)
Declare PtrSafe Function SetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)


' Déclaration des constantes
Public Const GWL_STYLE As Long = -16
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_FULLSIZING = &H70000

'Attention, envoyer après changement du caption de l'UF
Public Sub InitMaxMin(mCaption As String, Optional Max As Boolean = True, Optional Min As Boolean = True, Optional Sizing As Boolean = True)
Dim hWnd As Long
    hWnd = FindWindowA(vbNullString, mCaption)
    If Max Then SetWindowLongA hWnd, GWL_STYLE, GetWindowLongA(hWnd, GWL_STYLE) Or WS_MAXIMIZEBOX
    If Min Then SetWindowLongA hWnd, GWL_STYLE, GetWindowLongA(hWnd, GWL_STYLE) Or WS_MINIMIZEBOX
    If Sizing Then SetWindowLongA hWnd, GWL_STYLE, GetWindowLongA(hWnd, GWL_STYLE) Or WS_FULLSIZING
End Sub

Código: Selecionar todos


Option Explicit

Dim Lg As Single
Dim Ht As Single
Dim Fini As Boolean


Private Sub UserForm_Initialize()
Dim i As Integer, L As Integer, TB

    InitMaxMin Me.Caption
    Ht = Me.Height
    Lg = Me.Width

End Sub


Private Sub UserForm_Resize()
    Dim RtL As Single, RtH As Single
        If Me.Width < 300 Or Me.Height < 200 Or Fini Then Exit Sub
        RtL = Me.Width / Lg
        RtH = Me.Height / Ht
        Me.Zoom = IIf(RtL < RtH, RtL, RtH) * 100
End Sub


Private Sub UserForm_Terminate()
    Fini = True
End Sub
E eu quebrando a cara por pelo menos 3 anos para descobrir que meu código estava incompleto bah!!!

Valeu Rafael Amorim, estava com o mesmo problema que me incomodava faz tempo, tu salvou meu sistema haha


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder