Discussion :

[Alpha31]

Rebonsoir,

Je cherchais comment adapter ma présentation Access au différentes résolutions d'écran.

En cherchant sur le forum, j'ai trouvé un sujet résolu sur la question, ou la solution était :
de changer la résolution en ouvrant accesss et de la restaurer en le fermant.

Sur la Faq j'ai vu du code a rallonge permetant aussi de faire ceci.

Néamoins, d'un coté ou de l'autre je trouve que ca fait usine a gaz toutes ces méthodes, n'y a til pas un moyen trés trés simple pour adapter ca présentation a n'importe quel Résol ?

Merci
Alpha

[ActionAccess]

Bonjour,

Access ne ré-ajustant pas les formulaires ni les contrôles qu'ils contiennent à la résolution de l'écran, la différence entre le formulaire et la résolution de l'écran de l'utilisateur peut représenter un véritable inconfort.
Le code présenté ci-dessous permet de modifier le formulaire pour qu'il s'ajuste à la résolution de l'écran. Je ne connais pas de méthode plus simple.

MODULE qui permet de retrouver la résolution actuelle de l'écran:
ResolY donne la résolution en Y.
ResolX donne la résolution en X.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Option Compare Database
Option Explicit
 
Public Declare Function apiGetSys Lib "user32.dll" _
    Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
 
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const SM_CXVSCROLL = 2
Private Const SM_CYHSCROLL = 3
Private Const SM_CYCAPTION = 4
Private Const SM_CXBORDER = 5
Private Const SM_CYBORDER = 6
Private Const SM_CXDLGFRAME = 7
Private Const SM_CYDLGFRAME = 8
Private Const SM_CYVTHUMB = 9
Private Const SM_CXHTHUMB = 10
Private Const SM_CXICON = 11
Private Const SM_CYICON = 12
Private Const SM_CXCURSOR = 13
Private Const SM_CYCURSOR = 14
Private Const SM_CYMENU = 15
Private Const SM_CXFULLSCREEN = 16
Private Const SM_CYFULLSCREEN = 17
Private Const SM_CYKANJIWINDOW = 18
Private Const SM_MOUSEPRESENT = 19
Private Const SM_CYVSCROLL = 20
Private Const SM_CXHSCROLL = 21
Private Const SM_DEBUG = 22
Private Const SM_SWAPBUTTON = 23
Private Const SM_RESERVED1 = 24
Private Const SM_RESERVED2 = 25
Private Const SM_RESERVED3 = 26
Private Const SM_RESERVED4 = 27
Private Const SM_CXMIN = 28
Private Const SM_CYMIN = 29
Private Const SM_CXSIZE = 30
Private Const SM_CYSIZE = 31
Private Const SM_CXFRAME = 32
Private Const SM_CYFRAME = 33
Private Const SM_CXMINTRACK = 34
Private Const SM_CYMINTRACK = 35
Private Const SM_CXDOUBLECLK = 36
Private Const SM_CYDOUBLECLK = 37
Private Const SM_CXICONSPACING = 38
Private Const SM_CYICONSPACING = 39
Private Const SM_MENUDROPALIGNMENT = 40
Private Const SM_PENWINDOWS = 41
Private Const SM_DBCSENABLED = 42
Private Const SM_CMOUSEBUTTONS = 43
Private Const SM_CMETRICS = 44
 
Public Function ResolX(strWhat As String) As String
Dim strRet As String
    Select Case LCase(strWhat)
        Case "resolution"
        strRet = apiGetSys(SM_CXSCREEN)
        Case "windowsize"
        strRet = apiGetSys(SM_CXFULLSCREEN)
    End Select
 
    ResolX = strRet
End Function
 
Public Function ResolY(strWhat As String) As String
Dim strRet As String
    Select Case LCase(strWhat)
        Case "resolution"
        strRet = apiGetSys(SM_CYSCREEN)
        Case "windowsize"
        strRet = apiGetSys(SM_CYFULLSCREEN)
    End Select
 
    ResolY = strRet
End Function

Ensuite la Sub qui effectue le redimmensionnement et repositionnement des contrôles du formulaire, et qui modifie même les polices (à insérer dans le module du formulaire par exemple) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub ResizeForResolution(ByVal RatioX As Single, ByVal RatioY As Single)
 
Dim RatioPolices As Single
 
RatioPolices = (RatioX + RatioY) / 2
 
Me.Width = ResolX("windowsize") * RatioX 'redéfinit la largeur du formulaire.
 
Dim j As Integer
For j = 0 To 9
    If SectionExiste(j) = True Then 'voir la fonction plus bas
    Me.Section(j).Height = Me.Section(j).Height * RatioY
    End If
Next
 
Dim i As Integer
For i = 0 To Me.Controls.Count - 1
    Debug.Print Me.Controls(i).Name
    If TypeOf Me.Controls(i) Is ComboBox Then
        Me.Controls(i).Move Me.Controls(i).Left * RatioX, Me.Controls(i).Top * RatioY, Me.Controls(i).Width * RatioX
    Else
        Me.Controls(i).Move Me.Controls(i).Left * RatioX, Me.Controls(i).Top * RatioY, Me.Controls(i).Width * RatioX, Me.Controls(i).Height * RatioY
    End If
    If TypeOf Me.Controls(i) Is Label Then Me.Controls(i).FontSize = Me.Controls(i).FontSize * RatioPolices
Next
 
End Sub

Enfin, sur l'évènement Chargement du formulaire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Form_Load()
 
'Résolution correspondant à la form telle qu'elle est en mode conception,
'donc celle du portable ou ordinateur de départ
Const ResolutionRefX As Long = 640
Const ResolutionRefY As Long = 480
 
'Rapport entre la résolution actuelle et celle de référence
Dim RatioX As Single
Dim RatioY As Single
 
'Résolution actuelle
Dim ResolutionX As Long
Dim ResolutionY As Long
 
ResolutionX = ResolX("resolution")
ResolutionY = ResolY("resolution")
 
'ratio multiplicateur des tailles et positions
RatioX = ResolutionX / ResolutionRefX
RatioY = ResolutionY / ResolutionRefY
 
'Adapte les dimensions en fonction de la résolution actuelle
'Appel de la fonction ResizeForResolution 
ResizeForResolution RatioX, RatioY
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Function SectionExiste(numSection) As Boolean
On Error GoTo GestionErreur
Debug.Print Me.Section(numSection).Height
 
SectionExiste = True
Exit Function
 
GestionErreur:
SectionExiste = False
End Function

Espérant t'avoir aidé,

Cdlt,

[Alpha31]

Fichtre

Ca s'en est du code a rallonge , balèze.

Ce que tu me dit c'est soit : On change la résolution du system
soit : on fait ce que tu vien de me mettre

Etant donné que je n'y connais pas grand chose en Vba, je recopie ca texto en changeant ca ?

= 640
= 480

En tout cas merci pour ton temp
Alpha

[ActionAccess]

Comme tu le vois, ce n'est pas simple, même si ce que tu demandes est souvent demandé. C'est une des lacunes d'Access.

Par conséquent, si tu n'y connais pas grand chose en VBA, tu risques de rencontrer des difficultés.

Mais essaie quand même de recopier selon les indications que je t'ai données et changes les "640" et "480" pour les adpater à ta résolution.

Bon courage

[Domi2]

Bonjour,

J'essaye de mettre en oeuvre le code fourni ci-avant par ActionAccess, et qui me donne de bon résultat sur une base test.

J'ai cependant une petite question. Le ratio hauteur / largeur étant le même selon la résolution choisie, quelle est l'intérêt, ou la nécessité, de déterminer et d'utiliser RatioX et RatioY ?

Merci d'avance.

Domi2