[XL-2007] ADapter un formulaire à la résolution de l'écran.

ADapter un formulaire à la résolution de l'écran.

Bonjour,
je développe une appli Excel avec des formulaires. Mon écran est en 1280 X 1024. Anticipant les autres résolutions possibles, mes formulaires ne dépassaient pas en taille 800 X 600. Par exemple il y en a un qui fait 700 X 580.
Or, quand je passe mon écran en 800 X 600, mon formulaire est beaucoup plus grand que l'écran.. Je ne comprends pas pourquoi, il est sensé être plus petit, non ?

Quelle est mon erreur ? Quelle est l'unité des formulaires, les pixels ?

Bonsoir,
J'ai le même problème.
Après avoir fureté sur google, j'ai trouvé une petite option qui calcule un coefficient "zoom"
Il ne faut pas oublier d'appeler des bibliothèques:

Code:

1
2
3
4
5
6
7
8
9
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
'Definition variables Affichage
Const GWL_STYLE = (-16), GWL_EXSTYLE = (-20), WS_SIZEBOX = &H40000, WS_TROIS_BOUTON = &H70000, WS_EX_APPWINDOW = &H40000
Public l(), h(), F(), p(), s() As String, wLong As Long, hWnd As Long, I, c As Control, la As Long, ha As Long
Public user As Object

D'abord le module Config_Ecran

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
'   Recupere la configuration actuelle de l ecran
Sub CaptureConfig()
I = 0: ha = user.Height: la = user.Width
For Each c In user.Controls
    I = I + 1
    ReDim Preserve l(I): l(I) = c.Width
    ReDim Preserve h(I): h(I) = c.Height
    ReDim Preserve p(I): p(I) = c.Top
    ReDim Preserve F(I): F(I) = c.Left
    ReDim Preserve s(I): s(I) = c.Width / c.Font.Size
 Next
hWnd = FindWindow(vbNullString, user.Caption)
wLong = GetWindowLongA(hWnd, GWL_STYLE) Or WS_SIZEBOX Or_ WS_TROIS_BOUTON
SetWindowLong hWnd, GWL_STYLE, wLong
End Sub
'   Calcule le facteur necessaire pour le zoom
Sub ZoomControles()
On Error Resume Next
I = 0
For Each c In user.Controls
    I = I + 1
    c.Width = user.Width / (la / l(I))
    c.Height = user.Height / (ha / h(I))
    c.Left = user.Width / (la / F(I))
    c.Top = user.Height / (ha / p(I))
    c.Font.Size = c.Width / s(I)
Next
End Sub
'   Teste la definition de l image (en pixel)
Sub DefinitionImage()
If GetSystemMetrics(0) > 800 Or GetSystemMetrics(1) > 800 Then  _ ShowWindow hWnd, 3
End Sub

ensuite, rajoute dans ton userform:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
Private Sub UserForm_Activate()
DefinitionImage
End Sub
 
Private Sub UserForm_Resize()
ZoomControles
End Sub
 
Private Sub UserForm_Initialize()
Set user = Me: CaptureConfig
'la suite de ton code

En espérant que cela t'aide. Par contre, je ne me souviens plus du site...

Citation:

Que l'on me corrige si je me suis trompé. Mais cela fonctionne sur Excel 2003

super, merci pour ta réponse !

Mais de rien. Essaye pour voir si cela fonctionne sur d'autre version d'Excel (>2003).