sheets aanpassen aan beeldresolutie

[bowlingman]

Hallo,
Ik ga nog eens aan de slag om mijn bowlingscore-progjes aan te passen voor het nieuwe seizoen.
Ik heb alvorens ik begin even een vraagje.
Is het mogelijk om via VBA alle sheets in een workbook automatisch aan te passen aan de beeldresolutie bij het opstarten van het progje.
Bv. met een "Sub Auto_open" te plaatsen in een module. Zo ja hoe is dan de code hiervoor.

Grtjs.
Armand

 

[bowlingman]

Nog niemand die een eventuele oplossing weet ?

 

[bowlingman]

Dit zijn codes die ik een tijdje geleden heb gevonden bij een item van het Officeforum, auteur Radjesh Klauske

Option Explicit* * *'Plaats deze code in een KlasseModule met de naam Klasse1

' 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 GetCurrentWidth()
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
* * GetCurrentWidth = vidWidth
End Property

Property Get GetCurrentHeight()
* * 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
* * GetCurrentHeight = vidHeight
End Property

Private Sub UserForm_Initialize()* * 'Plaats deze code in de UserForm
Dim j As Integer
Dim Reso As New Klasse1
* *
* * With Me
* * * * .Top = 0
* * * * .Left = 0
* * * * .Height = (Reso.GetCurrentHeight / 4) * 3
* * * * .Width = (Reso.GetCurrentWidth / 4) * 3
* * End With
* *
* * With Me
* * For j = 0 To .Controls.Count - 1
* * * * With .Controls(j)
* * * * * * .Top = .Top * Reso.GetCurrentHeight / 600
* * * * * * .Height = .Height * Reso.GetCurrentHeight / 600
* * * * * * .Left = .Left * Reso.GetCurrentHeight / 600
* * * * * * .Width = .Width * Reso.GetCurrentHeight / 600
* * * * * * .Font.Size = Int(.Font.Size * Reso.GetCurrentHeight / 600)
* * * * End With
* * Next
* * End With

en reeds zelf heb gebruikt in een file van mijzelf.
Maar dit gaat wel over een Userform
Kan dit op de een of andere wijze aangepast worden op een Excelbestand, zodat elke sheet in dat bestand wordt aangepast aan de beeldschermgrootte van de pc waar het op geopend wordt.

Grtjs.
Armand

 

[Niels28]

Wat wil je nu precies verandert hebben per scherm?
Bedoel je het zoompercentage zodat je alles in beeld hebt?
dat kan bv zo:

Private Sub Workbook_Open()

    Application.WindowState = xlMaximized
    
    H_Origineel = 792 'mijn resolutie = 792
    W_Origineel = 1452 'mijn resolutie = 1452
    
    H_Activescreen = Application.Height
    W_Activescreen = Application.Width
    
    ActiveWindow.Zoom = WorksheetFunction.Min(H_Activescreen / H_Origineel * 100, W_Activescreen / W_Origineel * 100)

End Sub

ik heb 2 schermen op de grootste heb ik een bestandje gemaakt, op de kleine krijg ik op deze manier even veel kolommen in beeld,
wel meer rijen omdat de ene breedbeeld is en de andere niet. Zoompercentage wordt dan 66%

Niels

 

[bowlingman]

Hallo Niels,
Bedankt voor je reactie.
Ga dit straks eens uitproberen, laat nog wel iets weten

Grtjs.
Armand

 

[bowlingman]

Hallo Niels,

Werkt perfect maar enkel alleen op de eerste sheet("Start") welke steeds opstart als ik de file open.
In de file zitten ongeveer 11 sheets, allen met een andere benaming.
Is het nu mogelijk om deze code aan te passen dat de zoom wordt gebruikt op alle sheets.

Grtjs.
Armand

 

[Niels28]

Private Sub Workbook_Open()

    Application.WindowState = xlMaximized
    
    H_Origineel = 792 'mijn resolutie = 792
    W_Origineel = 1452 'mijn resolutie = 1452
    
    H_Activescreen = Application.Height
    W_Activescreen = Application.Width
    
    Application.ScreenUpdating = False
    
    For Each sh In ThisWorkbook.Sheets
    sh.Activate
    ActiveWindow.Zoom = WorksheetFunction.Min(H_Activescreen / H_Origineel * 100, W_Activescreen / W_Origineel * 100)
    Next
    
    Application.ScreenUpdating = True
    
End Sub

Niels

 

[bowlingman]

Bedankt Niels,

Werkt perfect.
Heb ook nog het volgende toegevoegd

Sheets("Start").Activate
    With Sheets("Start")
        Range("A1").Select
    End With

Zodat de file steeds opstart met de eerste sheet.

Grtjs.
Armand

 

[Niels28]

Zet je de vraag dan op opgelost.

Niels