Excel VBA Userform Planilha formata tamanho tela api -

Planilha Excel VBA userform formata tamanho tela api

Excel VBA Userform Planilha formata tamanho tela api

Estes Macros e procedimentos do Aplicativo Microsoft Excel VBA(Visual Basic Application), API ‘s redimensiona um Userform para o tamanho da tela, insere uma borda através de labels e também retira e insere a barra de títulos.
abre outro formulario no modo Modal.

Option Explicit
‘Este programa dá forma completa qualquer resolução
‘E o tamanho do ecrã, através da utilização de funções API.
‘a borda pode ser facilmente alterada, se necessário.

‘declarações obrigatórias

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 iditem As Long, ByVal wflags As Long) As Long
Private Declare Function FindWindow Lib “User32” Alias “FindWindowA” (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib “User32” (ByVal hWnd As Long, ByVal nCmdShow 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 GetWindowLong Lib “User32” Alias “GetWindowLongA” (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function IsIconic Lib “User32” (ByVal hWnd As Long) As Long
Private Declare Function IsZoomed Lib “User32” (ByVal hWnd As Long) As Long ‘non utilisée ici
Private Declare Function DrawMenuBar Lib “User32” (ByVal hWnd As Long) As Long
Private Declare Function SendMessage Lib “User32” Alias “SendMessageA” _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub RealizarCaptura Lib “User32” ()

‘
Private Const SW_MAXIMIZE = 3                   ‘passando as contanstes a função
Private Const SW_MINIMIZE As Long = 6           ‘Abrir Window
‘
Private Const GWL_STYLE As Long = (-16)         ‘deslocamento do estilo de uma janela
Private Const WS_MINIMIZEBOX = &H20000          ‘Estilo para adicionar uma caixa Minimizar na barra de título
Private Const WS_CAPTION As Long = &HC00000     ‘Estilo para adicionar uma barra de título
‘
Private Const SC_MOVE = &HF010                  ‘constantes
Private Const SC_CLOSE = &HF060                 ‘para a função
Private Const MF_BYCOMMAND = &H0                ‘Deletar menu
‘
Private Const WM_NCLBUTTONDOWN = &HA1           ‘para as constantes
Private Const HTCAPTION = 2                     ‘mover sem o título
Dim hWnd As Long                                ‘barra do formulario
Dim wInit As Long, hInit As Long                ‘suas dimensoes originais
Dim FormInit As Boolean                         ‘define a etapa de inicialização do formulário
Dim FormSansTitre As Boolean                    ‘ddefine o passo de remoção do título
Dim FormST As Boolean                           ‘define o estado do formulário
‘

Private Sub CommandButton3_Click()              ‘o formulário com título
Dim iStyle As Long, hMenu As Long
CommandButton5.BackColor = &H8000000F
CommandButton3.BackColor = &HFFFF80
‘restaura a barra de título, se necessário …
iStyle = GetWindowLong(hWnd, GWL_STYLE)     ‘é o estilo do sistema de menus
iStyle = iStyle Or WS_CAPTION               ‘queremos um título (combinação de bits)
SetWindowLong hWnd, GWL_STYLE, iStyle       ‘aplicar o novo estilo
hMenu = GetSystemMenu(hWnd, 0)
DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND    ‘desativar botão exclui
DrawMenuBar hWnd                            ‘deve redesenhar a barra de título!

FormST = False
‘o sinal de minimizar a forma, precisamos ocultar qd tem um título
imgMini.Visible = False
Bordas
End Sub

‘//=============’
Private Sub CommandButton4_Click()
Unload Me
End Sub

Private Sub CommandButton5_Click()              ‘ forma sem título
CommandButton5.BackColor = &HFFFF80
CommandButton3.BackColor = &H8000000F
Dim iStyle As Long
FormSansTitre = True
iStyle = GetWindowLong(hWnd, GWL_STYLE)     ‘é o estilo do sistema de menus
iStyle = iStyle And Not WS_CAPTION          ‘nós não queremos título
SetWindowLong hWnd, GWL_STYLE, iStyle       ‘aplicar o novo estilo
DrawMenuBar hWnd
FormSansTitre = False
FormST = True

‘deve mostrar o sinal para minimizar a forma
imgMini.Visible = True
Bordas
lbG.Left = 3
End Sub
‘//=============’
Private Sub CommandButton6_Click()
Me.Hide
frmUSFMODAL.Show
Me.Show
End Sub

‘//=============’
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim Resposta As String
Resposta = MsgBox(“deseja conectar com nosso site ?”, vbYesNo + vbQuestion, “Saberexcel – site das macros”)
If Resposta = vbYes Then
ThisWorkbook.FollowHyperlink “http://www.sabertexcel.com.br/“, , True
End If
End Sub

Private Sub imgMini_Click() ‘minimiza a forma quando não há barra de título
ShowWindow hWnd, SW_MINIMIZE
End Sub

Private Sub optF_Click() ‘evita o movimento fazer do formulário
Dim hMenu As Long
hMenu = GetSystemMenu(hWnd, 0) ‘barra de titulo do formulário
DeleteMenu hMenu, SC_MOVE, MF_BYCOMMAND
optF.BackColor = &HFFC0FF
optM.BackColor = &H8000000F
End Sub

Private Sub optM_Click() ‘restaura a mobilidade do formulário
Dim hMenu As Long
hMenu = GetSystemMenu(hWnd, 1)
DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND ‘desativar botão excluir
DrawMenuBar hWnd
optM.BackColor = &HFFC0FF
optF.BackColor = &H8000000F
End Sub

Private Sub ToggleButton1_Click() ‘tornar visivel os labels para formar bordas
If ToggleButton1 Then ToggleButton1.BackColor = &H80FF80 Else ToggleButton1.BackColor = &H8000000F
lbH.Visible = ToggleButton1
lbB.Visible = ToggleButton1
lbG.Visible = ToggleButton1
lbD.Visible = ToggleButton1
lbHG.Visible = ToggleButton1: lbHD.Visible = ToggleButton1
lbBG.Visible = ToggleButton1: lbBD.Visible = ToggleButton1
End Sub

Private Sub UserForm_Activate()
ShowWindow hWnd, SW_MAXIMIZE ‘maximizar o formulario na abertura, objetivo desse código
End Sub

‘//=============’
Private Sub UserForm_Initialize()
Dim iStyle As Long, hMenu As Long
hWnd = FindWindow(vbNullString, Me.Caption) ‘barra do formulario
hMenu = GetSystemMenu(hWnd, 0)              ‘barra do sistema de menu
iStyle = GetWindowLong(hWnd, GWL_STYLE)     ‘estilo do sistema de menu
iStyle = iStyle Or WS_MINIMIZEBOX           ‘adicionar o botão maximizar
SetWindowLong hWnd, GWL_STYLE, iStyle       ‘aplicar um novo estilo
DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND    ‘desativar o botão suprimir
wInit = Me.Width: hInit = Me.Height
FormInit = True
Bordas
optF.Value = True
End Sub
‘//=========’
Private Sub UserForm_Resize()
Dim RW As Single, RH As Single
If IsIconic(hWnd) <> 0 Then Exit Sub    ‘a forma é um ícone no redimensionamento
If FormInit = False Then Exit Sub       ‘deve-se realizar controles de redimensionamento de uma vez no iníciar!
If FormSansTitre = True Then Exit Sub   ‘não executar o redimensionamento quando o título é removido…
‘parametros de aumento
RW = Me.Width / wInit: RH = Me.Height / hInit
    ‘redimensionamento e reposicionamento de toda a função de controle desejado sobre o ecrã
Dim Ctl As MSForms.Control
For Each Ctl In Me.Controls
   ‘Inseri tag para os controles que você não deseja redimensionar
If Ctl.Tag = “” Then Ctl.Move Ctl.Left * RW, Ctl.Top * RH, Ctl.Width * RW, Ctl.Height * RH
If Not TypeOf Ctl Is Image Then     ‘Se necessário, adicionar outros controles sem fontes
Ctl.Font.Size = Round(Ctl.Font.Size * RH)   ‘redimensionamento também das fontes
End If
Next
    Bordas
lbG.Left = 3    ‘Curiosamente, se você colocar 0, a borda não é propriamente visível em tela cheia …?
‘para 0 e ajustar as outras dimensões, se necessário
lbHG.Left = 3: lbBG.Left = 3
lbH.Left = 9: lbB.Left = 9      ‘6 (largura borda) + 3 (retirada total)
‘colocação do sinal para minimizar o formulário nao contiver o título
imgMini.Top = 6
imgMini.Left = Me.InsideWidth – imgMini.Width – 6
FormInit = False
End Sub
‘//=============’

Private Sub Bordas() ‘ajusta o tamanho ea posição da margem
lbH.Width = Me.InsideWidth – 15 ‘(2*6 + 3)
lbB.Width = Me.InsideWidth – 15: lbB.Top = Me.InsideHeight – lbB.Height
lbG.Height = Me.InsideHeight – 12
lbD.Height = Me.InsideHeight – 12
lbD.Left = Me.InsideWidth – lbD.Width
lbBG.Top = lbG.Top + lbG.Height
lbHD.Left = lbD.Left
lbBD.Top = lbD.Top + lbD.Height
lbBD.Left = lbHD.Left
End Sub

‘//===================’
‘para mover o formulário sem barra de título com o botão esquerdo do mouse
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
On Error Resume Next
If Button = 1 Then
If FormST Then
Call RealizarCaptura
SendMessage hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
Else
Call RealizarCaptura
End If
End If
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.