MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


    Redimensionar subform

    Edgar Massa
    Edgar Massa
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 84
    Registrado : 08/01/2017

    Redimensionar subform Empty Redimensionar subform

    Mensagem  Edgar Massa 27/4/2021, 00:40

    Prezados

    Boa noite

    Eu tenho um subform, onde eu estou configurando o redimensionamento dos forms, controles e subforms com ancoragem do Access, para que funcione em computadores de outros usuários da resolução 1024x768 até a resolução 1920x1080, tudo está perfeito, porém, meus subforms estão no formato folha de dados (tabela), e se eu deixar as larguras das colunas para que caiba no subform na resolução 1024x768, quando ele redimensiona em resoluções altas, as colunas não acompanham a larga para que fique correta dentro do subform, tem algo que dê para fazer nesse sentido?

    Noobezinho
    Noobezinho
    Moderador
    Moderador

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 4058
    Registrado : 29/06/2012

    Redimensionar subform Empty Re: Redimensionar subform

    Mensagem  Noobezinho 27/4/2021, 12:35

    Olá Edgar

    Tenho essa função que muda a resolução da tela enquanto estiver no BD.

    Ao mudar a resolução da tela, o Access acompanha o tamanho.

    É um código antigo, usava ele no Access 97.

    Mas ainda funfa no Access 2010.

    Como de lá para cá, aumentou-se as resoluções dos monitores,

    poderá testar o que se encaixa no que deseja.

    Veja se isso te ajuda.

    Caso não ajude já vi a tempos na net códigos que ampliam os formulários e seus objetos.
    Mas na época não tive interesse.

    { }'s
    Balem

    O código:

    Código:


    Option Compare Database
    Option Explicit
    '************************************************** ***************
    ' DECLARATIONS SECTION
    '************************************************* ****************

    Type RECT
    x1 As Long
    y1 As Long
    x2 As Long
    y2 As Long
    End Type
    ' NOTE: The following declare statements are case sensitive.
    Declare PtrSafe Function GetDesktopWindow Lib "User32" () As Long
    Declare PtrSafe Function GetWindowRect Lib "User32" _
    (ByVal hwnd As Long, rectangle As RECT) As Long
    '================================================= =====
    'This code shows how to change the screen resolution.
    'Call the function like this:
    ' ChangeResolution 640, 480
    'This would change the screen resolution to 640 pixels x 480 pixels.
    'Note that 'you can only change the resolution to values supported by the display.

    'Paste the following code into a module:'
    Private Declare PtrSafe Function ChangeDisplaySettings Lib "User32" Alias _
    "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
    Private Declare PtrSafe Function EnumDisplaySettings Lib "User32" Alias _
    "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
    Const DM_PELSWIDTH = &H80000
    Const DM_PELSHEIGHT = &H100000
    Const CCFORMNAME = 32
    Const CCDEVICENAME = 32
    Private Type DEVMODE
    dmDeviceName As String * CCDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
    End Type

    Global Largura As Single
    Global Altura As Single


    Public Function Change_Resolution(iWidth As Single, iHeight As Single)
    Dim DevM As DEVMODE
    Dim a As Boolean
    Dim I As Long
    Dim b As Long
    I = 0
    'Enumerate settings
    Do
    a = EnumDisplaySettings(0&, I&, DevM)
    I = I + 1
    Loop Until (a = False)
    'Change settings
    DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
    DevM.dmPelsWidth = iWidth
    DevM.dmPelsHeight = iHeight
    b = ChangeDisplaySettings(DevM, 0)
    End Function
    '************************************************* ****************
    ' FUNCTION: GetScreenResolution()
    '
    ' PURPOSE:
    ' To determine the current screen size or resolution.
    '
    ' RETURN:
    ' The current screen resolution. Typically one of the following:
    ' 640 x 480
    ' 800 x 600
    ' 1024 x 768
    '
    '************************************************* ****************
    Function GetScreenResolution() As String
    Dim R As RECT
    Dim hwnd As Long
    Dim RetVal As Long
    hwnd = GetDesktopWindow()
    RetVal = GetWindowRect(hwnd, R)
    GetScreenResolution = (R.x2 - R.x1) & "x" & (R.y2 - R.y1)
    End Function


    Public Function MudaTela()

    Largura = left(GetScreenResolution, InStr(1, GetScreenResolution, "x", 0) - 1)
    Altura = right(GetScreenResolution, Len(GetScreenResolution) - InStr(1, GetScreenResolution, "x", 0))

    If GetScreenResolution = "1152x864" Then ' resolução de tela em que o Sisvet deve trabalhar
       Exit Function
    Else
      Call Change_Resolution(1152, 864)
    End If
    End Function

    Public Function RetornaTela()
    If GetScreenResolution = Largura & "x" & Altura Then
       Exit Function
    Else
       Call Change_Resolution(Val(Largura), Val(Altura))
    End If
    End Function


    .................................................................................
    A pergunta que não quer calar:
    Por quê quando alguém vem pedir ajuda e conforme o caso pedimos
    para enviar parte do projeto, não temos mais continuidade do tópico?  
    Crê que temos bolas de cristal ou está com medo que "roubemos"  a
    idéia/projeto dele?  Twisted Evil
    Se é tão bom assim...

      Data/hora atual: 15/5/2021, 11:28