Das folgende vba Code-Beispiel zeigt, wie man automatisch Microsoft Access Datenbank Formulare auf die maximale Breite des aktuellen Monitors anpassen kann
Dabei werden alle Controls wie Textbox oder Label Elemente zur Laufzeit auf die entsprechenden Positionen verschoben und in der Breite und Höhe angepasst.
Das ist besonders hilfreich für Notebook-Versionen unter FullHD und parallel Desktop Workstations mit maximaler Auflösung.
Microsoft Access, Auto Skalierung auf maximale Breite mit vba Code
Formular-Anpassung, AutoScale, Auto Skalierung
Im Code wird der AutoSkale-vba Code ausgeführt, wenn man auf den Button Resize klickt.
Der vba Code kann natürlich auch im Formular zur OnLoad und On_Open geschoben werden.
Auto-Skalierung, autoScale
Automatisch auf die maximale Breite und Höhe des Monitors in Windows 10 angepasst skaliert
Vba Code
Vba Code für die Microsoft Access Anwendung
Option Compare Database Option Explicit On
Private Sub BtnResize_Click() '------------< Resize >------------- '-< Get_Scale >- '< X > '*horizontal Dim xStart As Long xStart = Me.Width If xStart < 0 Then xStart = (32768 / 2) - xStart End If
Dim xWindow As Long xWindow = Me.WindowWidth If xWindow < 0 Then xWindow = (32768 / 2) - xWindow End If If xWindow > 31000 Then xWindow = 31000 'max integer=32767 'maximale breite=2.048 lt Microsoft
'LogicalPageWidth
Dim ScaleX As Double ScaleX = xWindow / xStart '</ X >
'< Y > '*Vertical Dim yStart As Long yStart = Detailbereich.Height 'Section(0).Height 'Me.InsideHeight
Dim yHeader As Long yHeader = Section(1).Height
Dim yFooter As Long yFooter = Section(2).Height
'Status=30 Commandbar=30 ApplicationTitle=30 Counter=30 Dim yOffset As Long yOffset = 90
Dim yWindow As Long yWindow = Me.WindowHeight - yHeader - yFooter + yOffset
Dim ScaleY As Double ScaleY = yWindow / yStart '</ Y >
'-</ Get_Scale >- Dim ctl As Control For Each ctl In Me.Controls ctl.Left = ctl.Left * ScaleX ctl.Width = ctl.Width * ScaleX
If ctl.Section = 0 Then ctl.Top = ctl.Top * ScaleY
' 'On Error Resume Next ctl.Height = ctl.Height * ScaleY
End If Next '------------</ Resize >------------- End Sub
|