Office: (Office 2007) Formular an Bildschirmgröße anpassen

User · 17. Februar 2009

Hi,

ich habe eine Datenbank erstellt, welche ich nun in Front- und BAckend aufgeteilt habe.
Nun wollte ich das Frontend an einem anderen REchner testen, welcher auch eine andere Bildschirmgröße hat, schon so das alles verschoben aus.

Kann man das Formular eigentlich irgendwie immer an die aktuelle Bildschirmgröße anpassen?

Grüße und Danke

Nelly

:)

elmar · 18. Februar 2009

Nutze die Suche hier im Forum. Suchbegriff z.B.: Bildschirmauflösungabfrage, dort findest Du etwas zum Thema.
Allerdings musst Du Dich registrieren, um die Suche nutzen zu können.

Debus · 18. Februar 2009

Also, ich würde Dir davon abraten, aber hier mal ein funktionierender Code

Im Formular folgendes einbauen

Code:

Private Sub Form_Open(Cancel As Integer)

Form_Start_Height = Me.WindowHeight
Form_Start_Width = Me.WindowWidth
Form_Current_Height = Me.WindowHeight
Form_Current_Width = Me.WindowWidth

End Sub

Private Sub Form_Resize()

ResizeControls Me, Form_Current_Width, Form_Current_Height
Form_Current_Height = Me.WindowHeight
Form_Current_Width = Me.WindowWidth

End Sub

Private Sub Zoom_BeforeUpdate(Cancel As Integer)

DoCmd.MoveSize , , Form_Start_Width * Me!Zoom.Value, Form_Start_Height * Me!Zoom.Value

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

dann noch folgendes in einem Modul einbauen

Code:

Option Compare Database
Option Explicit

Public Sub ResizeControls(Formular As Form, ByVal StartFormularbreite As Long, ByVal StartFormularhöhe As Long)

Dim CHANGE_FACTOR As Double
Dim CHANGE_CONTROL As Control
Dim Breite As Integer
Dim Höhe As Integer
Dim RegHöhe As Integer
Dim RegBreite As Integer

If Not Formular.WindowWidth = 0 Then

CHANGE_FACTOR = Formular.WindowWidth / StartFormularbreite

If Not CHANGE_FACTOR = 1 Then

On Error Resume Next

If CHANGE_FACTOR > 1 Then
Formular.Section(0).Height = Formular.Section(0).Height * CHANGE_FACTOR
Formular.Section(1).Height = Formular.Section(1).Height * CHANGE_FACTOR
Formular.Section(2).Height = Formular.Section(2).Height * CHANGE_FACTOR
End If
For Each CHANGE_CONTROL In Formular.Controls

If CHANGE_CONTROL.ControlType = acSubform Then
Dim UFOBREITE As Integer
Dim UFOHÖHE As Integer

UFOBREITE = CHANGE_CONTROL.Width
UFOHÖHE = CHANGE_CONTROL.Height

CHANGE_CONTROL.Width = CHANGE_CONTROL.Width * CHANGE_FACTOR
CHANGE_CONTROL.Height = CHANGE_CONTROL.Height * CHANGE_FACTOR
CHANGE_CONTROL.Top = CHANGE_CONTROL.Top * CHANGE_FACTOR
CHANGE_CONTROL.Left = CHANGE_CONTROL.Left * CHANGE_FACTOR
Forms![frmResize]![frmResizeUFO].Form![RegisterStr3].Left = 0.3

ResizeControls CHANGE_CONTROL.Form, UFOBREITE, UFOHÖHE
Breite = Forms![frmResize]![frmResizeUFO].InsideWidth
Höhe = Forms![frmResize]![frmResizeUFO].InsideWidth
RegBreite = Forms![frmResize]![frmResizeUFO].Form![RegisterStr3].Width
RegHöhe = Forms![frmResize]![frmResizeUFO].Form![RegisterStr3].Height
If RegBreite > Breite Then
Forms![frmResize]![frmResizeUFO].Form![RegisterStr3].Width = Breite - 10
Forms![frmResize]![frmResizeUFO].Form![RegisterStr3].Height = Höhe - 10
ResizeControls CHANGE_CONTROL.Form, UFOBREITE, UFOHÖHE
End If

Else

CHANGE_CONTROL.Width = CHANGE_CONTROL.Width * CHANGE_FACTOR
CHANGE_CONTROL.Height = CHANGE_CONTROL.Height * CHANGE_FACTOR
CHANGE_CONTROL.Top = CHANGE_CONTROL.Top * CHANGE_FACTOR
CHANGE_CONTROL.Left = CHANGE_CONTROL.Left * CHANGE_FACTOR
CHANGE_CONTROL.FontSize = CHANGE_CONTROL.FontSize * CHANGE_FACTOR
End If

Next

If CHANGE_FACTOR < 1 Then
Formular.Section(0).Height = Formular.Section(0).Height * CHANGE_FACTOR
Formular.Section(1).Height = Formular.Section(1).Height * CHANGE_FACTOR
Formular.Section(2).Height = Formular.Section(2).Height * CHANGE_FACTOR
End If

Formular.Repaint

On Error GoTo 0

End If

End If

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Den folgende Code ebenfalls noch in ein Modul einbauen

Code:

Option Compare Database
Option Explicit

Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function CreateICA Lib "gdi32" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Private Type AP_ResizeType
Links As Double
Oben As Double
Breite As Double
Höhe As Double
Name As String
End Type

Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const TwipsPerInch = 1440
Private Const SM_CXFULLSCREEN = 16
Private Const SM_CYFULLSCREEN = 17
Private Const acDatasheetView = 2
Private Const MaxTwips = 22 * TwipsPerInch

Dim rectOriginal As RECT

Function FormularAnpassen(frm As Form, intX As Integer, intY As Integer, intDPIX As Integer, intDPIY As Integer)

Dim GrößenfaktorBreite As Double
Dim GrößenfaktorHöhe As Double

Auflösung_ermitteln intX, intY, intDPIX, intDPIY, GrößenfaktorBreite, GrößenfaktorHöhe

Formulargröße_ermittlen frm, rectOriginal

If (GrößenfaktorBreite = 1) And (GrößenfaktorHöhe = 1) Then Exit Function

DoCmd.RepaintObject

Größenanpassung frm, GrößenfaktorBreite, GrößenfaktorHöhe, rectOriginal, True

End Function
Private Sub Formulargröße_ermittlen(frm As Form, rct As RECT)

Dim hWndParent As Long
Dim rctParent As RECT

hWndParent = GetParent(frm.hwnd)

GetWindowRect frm.hwnd, rct

If hWndParent Application.hWndAccessApp Then
GetWindowRect hWndParent, rctParent
With rct
.Left = .Left - rctParent.Left
.Top = .Top - rctParent.Top
.Right = .Right - rctParent.Right
.Bottom = .Bottom - rctParent.Bottom
End With
End If

End Sub
Private Sub Auflösung_ermitteln(ByVal intX As Integer, ByVal intY As Integer, ByVal intDPIX As Integer, ByVal intDPIY As Integer, ByRef GrößenfaktorBreite As Double, ByRef GrößenfaktorHöhe As Double)
On Error GoTo Err_Auflösung_ermitteln

Dim intScreenX As Integer
Dim intScreenY As Integer
Dim lngIC As Long

lngIC = CreateICA("DISPLAY", vbNullString, vbNullString, vbNullString)

If lngIC 0 Then
intScreenX = GetSystemMetrics(SM_CXFULLSCREEN)
intScreenY = GetSystemMetrics(SM_CYFULLSCREEN)

GrößenfaktorBreite = intScreenX / intX
GrößenfaktorHöhe = intScreenY / intY

GrößenfaktorBreite = GrößenfaktorBreite * (intDPIX / GetDeviceCaps(lngIC, LOGPIXELSX))
GrößenfaktorHöhe = GrößenfaktorHöhe * (intDPIY / GetDeviceCaps(lngIC, LOGPIXELSY))

DeleteDC lngIC
End If

Exit_Auflösung_ermitteln:
Exit Sub

Err_Auflösung_ermitteln:
If Err.Number = 11 Then
Resume
Else
MsgBox Err.Description
Resume Exit_Auflösung_ermitteln
End If

End Sub
Private Sub Größenanpassung(frm As Form, GrößenfaktorBreite As Double, GrößenfaktorHöhe As Double, rct As RECT, fMove As Integer)
On Error GoTo Err_Größenanpassung

Dim iTmp As Integer
Dim intBreite As Integer
Dim intHöhe As Integer
Dim ctl As Control
Dim Schriftgröße As Double
Dim i As Integer
Dim iGruppe As Integer
Dim Gruppe() As AP_ResizeType
Dim TmpGröße As Variant

DoCmd.Hourglass True

frm.Painting = False

If GrößenfaktorHöhe > 1 Then
Bereiche_anpassen frm, GrößenfaktorHöhe
TmpGröße = frm.Width * GrößenfaktorBreite
If TmpGröße > MaxTwips Then
frm.Width = MaxTwips
Else
frm.Width = TmpGröße
End If
End If

iGruppe = Gruppen_anpassen(frm, Gruppe(), GrößenfaktorBreite, GrößenfaktorHöhe)

For Each ctl In frm.Controls
Select Case ctl.ControlType
Case acOptionGroup, acTabCtl, acPage
GoTo Next_Ctl
Case acSubform
Größenanpassung ctl.Form, GrößenfaktorBreite, GrößenfaktorHöhe, rct, False
GoTo Next_Ctl
End Select

If Schrift_ändern(ctl) Then
Schriftgröße = ctl.FontSize * GrößenfaktorHöhe
Else
Schriftgröße = -1
End If

If frm.CurrentView acDatasheetView Then
ctl.Top = ctl.Top * GrößenfaktorHöhe
ctl.Left = ctl.Left * GrößenfaktorBreite
ctl.Width = ctl.Width * GrößenfaktorBreite
End If

If Höhe_ändern(ctl) Then
ctl.Height = ctl.Height * GrößenfaktorHöhe
End If

If Schriftgröße >= 1 And Schriftgröße MaxTwips, MaxTwips, varTemp)
Next i
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Aber wie schon gesagt, ich würde es lassen :=)

Holger

User · 18. Februar 2009

Hallo,

ui klingt recht aufwendig...warum würdest du es lassen?

Ich habe gerade mal geschaut. Mein Bildschirm hat eine Auflösung von 1440x900. Darin habe ich die DB erstellt.
Ich glaub die meisten anderen haben auch diese Größe, da wäre es kein Problem.
Aber hab es grad mal bei einer Auflösung von 1280x1024 getestet, da sieht alles so zusammengedrückt aus.

Vielleicht kann man die 1440x900 Auflösung als Standard nehmen und wenn es kleiner ist, kann man ja über den Scrollbalken das ganze bedienen.

Kann man die Größe festsetzen?

elmar · 18. Februar 2009

Mit Sicherheit ist es am einfachsten, wenn Du die gleiche Auflösung wie auf den FE-Rechnern auf dem Entwicklungsrechner nutzt. Alles andere ist nicht zu empfehlen.

Walter Grimm · 18. Februar 2009

Generell sollte man in der niedrigsten Auflösung entwickeln und dann eher nach oben anpassen. Nach unten geht es mit den meisten Tools nicht oder nur sehr schlecht.

Nach oben geht es meistens, wenn auch mit gewissen Einschränkungen. Hier gilt es zu testen und seine Forms evtl. so zu designen, dass sie sich auch einigermaßen scalieren lassen.

Hier ein Tool, was ich selber einsetze und welches etwas besser funktioniert, als das, was Debus vorschlägt (das habe ich auch eine Weile verwendet und sogar angepasst). Das Tool lässt sich im Load - Ereignis eines Forms mit einem Einzeiler aufrufen, so hält sich der Aufwand in Grenzen:

http://www.jamiessoftware.tk/downloads.html

und dort FormResizer.

Office: (Office 2007) Formular an Bildschirmgröße anpassen

Formular an Bildschirmgröße anpassen

Formular an Bildschirmgröße anpassen

Formular an Bildschirmgröße anpassen

Formular an Bildschirmgröße anpassen - Similar Threads - Formular Bildschirmgröße anpassen

Suchfeld in Formular

Formularsteuerelement Textfeld: Selbe Formatierung wie verlinkte Zelle?

Word Steuerelemente/Formular erstellen

Aktuelles Datum und Uhrzeit in Formular

Access Neuer Datensatz im Formular

mit String aus Formular Übereinstimmung in Abfrage prüfen

erstellte Formulare versenden