Access Formulare automatisch auf die
maximale Monitorgröße anpassen
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
|