Ik gebruik sinds een tijdje onderstaande code om userformulieren fullscreen weer te laten geven, met de juiste verhouding van de gegevens (met hulp van dit forum!)
Werkt prachtig, alleen kan ik nu het formulier nog verplaatsen. Dit leidt er in praktijk mogelijk toe, dat mijn formulieren 'zoekraken'
:shocked: .
Hoe kan ik zorgen dat dit niet gebeurd? In windows programma's kun je ze 'fullscreen' zetten, zodat je ze niet kunt verplaatsen, maar ook aanpassen zodat dit wel kan + zichtbaar op de taakbalk en minimaliseren naar de taakbalk. De openstaande formulieren kun je dan via je taakbalk wel weer terug vinden.
En de Klasse module
Groeten,
Jarod
ps: long time no see btw, 'k heb weinig tijd gehad voor m'n personal projectje helaas!
Werkt prachtig, alleen kan ik nu het formulier nog verplaatsen. Dit leidt er in praktijk mogelijk toe, dat mijn formulieren 'zoekraken'

Hoe kan ik zorgen dat dit niet gebeurd? In windows programma's kun je ze 'fullscreen' zetten, zodat je ze niet kunt verplaatsen, maar ook aanpassen zodat dit wel kan + zichtbaar op de taakbalk en minimaliseren naar de taakbalk. De openstaande formulieren kun je dan via je taakbalk wel weer terug vinden.
Code:
Dim big(10, 1) As Integer
'SCHERMINSTELLINGEN'
Private Sub UserForm_Initialize()
Dim SchermMaten As New cScreenRes ' Verwijzing naar klassemodule
Dim iControls As Integer ' Aantal besturingselementen
On Error Resume Next
' Schermresolutie wordt weergegeven in pixels
' Moet vermenigvuldigd worden met 3/4 om de juiste maten te krijgen
Me.Width = SchermMaten.SchermBreedte * 3 / 4
Me.Height = SchermMaten.SchermHooghte * 3 / 4
' Besturingselementen worden allen aangepast aan de nieuwe schermresolutie.
' Vermits ze oorspronkelijk gemaakt zijn met een schermhoogte van 600 (800 x 600)
' wordt dit getal in de berekening opgenomen.
With Me
For iControls = 0 To .Controls.Count - 1
With .Controls(iControls)
.Top = .Top * SchermMaten.SchermHooghte / 840
.Height = .Height * SchermMaten.SchermHooghte / 840
.Left = .Left * SchermMaten.SchermBreedte / 1060
.Width = .Width * SchermMaten.SchermBreedte / 1060
.Font.Size = Int(.Font.Size * SchermMaten.SchermHooghte / 840)
End With
Next
End With
En de Klasse module
Code:
Option Explicit
' 32-bit API declaration
Private Declare Function GetSystemMetrics32 Lib "user32" _
Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
' 16-bit API declaration
Private Declare Function GetSystemMetrics16 Lib "user" _
Alias "GetSystemMetrics" (ByVal nIndex As Integer) As Integer
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
Property Get SchermBreedte()
Dim vidWidth As Integer
If Left(Application.Version, 1) = 5 Then
' 16-bit Excel
vidWidth = GetSystemMetrics16(SM_CXSCREEN)
Else
' 32-bit Excel
vidWidth = GetSystemMetrics32(SM_CXSCREEN)
End If
SchermBreedte = vidWidth
End Property
Property Get SchermHooghte()
Dim vidHeight As Integer
If Left(Application.Version, 1) = 5 Then
' 16-bit Excel
vidHeight = GetSystemMetrics16(SM_CYSCREEN)
Else
' 32-bit Excel
vidHeight = GetSystemMetrics32(SM_CYSCREEN)
End If
SchermHooghte = vidHeight
End Property
Groeten,
Jarod
ps: long time no see btw, 'k heb weinig tijd gehad voor m'n personal projectje helaas!
Bijlagen
Laatst bewerkt: