Discussion :

[marot_r]

Bonjour a tous et merci pour votre temps et pour votre aide.

J'ai un petit soucis d'interface qui necessite de detecter qu'un formulaire vient d'etre maximiser pour le ramener a une taille legerement inferieure la taille de la fenetre de windows.

Le code suivant fait cela :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Public Sub ResizeMaxForm(prmForm As Form)
 
    prmForm.Visible = True
    DoCmd.Maximize
    Dim l As Long: l = prmForm.WindowLeft
    Dim t As Long: t = prmForm.WindowTop
    Dim w As Long: w = prmForm.WindowWidth - 300
    Dim h As Long: h = prmForm.WindowHeight - 750
    DoCmd.Restore
    Call DoCmd.MoveSize(0, 0, w, h)
 
End Sub

Mon probleme est de declencher ce code au bon moment, c-a-d dire quand mon utilisateur double clique dans la barre du formulaire pour le maximiser ou sur l'icone de maximisation.

J'ai essaye avec l'evenement OnResize avec un effet bizare.

Deja il semble s'executer 2 fois.

Ensuite, la 1ere fois que j'execute mon code tout fonctionne et mon formulaire est redimensionne correctement mais apres le formulaire devient "inerte". Double cliquer sur la barre de formulaire ne declenche plus la maximisation et on ne peut plus non plus dimensionner le formulaire avec la souris.

Je n'ai pas vu d'evenement autre que je pourrais utiliser.

Quelqu'un aurait-il une idee ?

A+

[loufab]

Salut René !

Il y a Paint avec son problème récurent, il s'exécute "à perpétuité".

Cordialement,

[marot_r]

Salut Farbrice et merci de ta contribution.

Par contre je ne saisi pas en quoi cela peut m'aider a resoudre mon probleme.

A+

[loufab]

je faisais allusion à l'évènement "Sur le dessin" d'une zone.
Le problème c'est qu'il est réfractaire à l'utilisation d'une modification d'affichage.

[micniv]

Bonjour,
René,
sous Access 2010 je ne vois pas de difficulté :
Avec le code suivant :

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 btClose_Click()
    DoCmd.Close
    DoCmd.OpenForm "F_Entrees"
End Sub
 
Private Sub Form_Open(Cancel As Integer)
Call ResizeMaxForm(Me)
End Sub
 
Public Sub ResizeMaxForm(prmForm As Form)
    DoCmd.Echo False
    DoCmd.Maximize
    Dim l As Long: l = prmForm.WindowLeft
    Dim t As Long: t = prmForm.WindowTop
    Dim w As Long
    Dim h As Long
    'w = prmForm.WindowWidth - 300
    'h = prmForm.WindowHeight - 750
    w = prmForm.WindowWidth - 1000
    h = prmForm.WindowHeight - 1500
 
    DoCmd.Restore
    Call DoCmd.MoveSize(0, 0, w, h)
    DoCmd.Echo True
 
End Sub

Ainsi, je lance ResizeMaxForm(Me) dans l'evt _open du form appelé "F_Entrees".
j'ai testé une dizaine d'appels: à la suite et c'est ok ...

[marot_r]

Merci pour tes tests micniv.

Le point important est que le formulaire est deja ouvert quand l'utilisateur le met en plein ecran.

Je suis d'accord avec toi a l'ouverture du formulaire c'est correct.

A+

[micniv]

Je propose une amélioration qui a l'air de fonctionner correctement :
A l'ouverture : 1 on mémorise les paramètres de l'ecran Max ; par la suite on n'a plus besoin de relancer .Maximize
2 on dimensionne l'écran

Ajouter 2 boutons Larger et Smaller qui permettent ensuite de jouer autant de fois que désiré avec les tailles d'écran : testé avec 3 forms différents.

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
 
Option Compare Database
Option Explicit
 
Dim mLeft As Long
Dim mTop As Long
Dim mWidth As Long
Dim mHeight As Long
 
Private Sub cmdLarger_Click()
    Call ResizeFormMax(Me)
End Sub
 
Private Sub cmdSmaller_Click()
    Call ResizeFormSmaller(Me)
End Sub
 
Private Sub cmdClose_Click()
    DoCmd.Close
End Sub
 
Private Sub Form_Open(Cancel As Integer)
'Call ResizeMaxForm(Me)
 
    Call MemoFormSizeMax(Me)
    Call ResizeFormMax(Me)
 
End Sub
 
Private Sub MemoFormSizeMax(oFrm As Form)
    DoCmd.Echo False
    DoCmd.Maximize
    mLeft = oFrm.WindowLeft
    mTop = oFrm.WindowTop
    'w = ofrm.WindowWidth - 300
    'h = ofrm.WindowHeight - 750
    mWidth = oFrm.WindowWidth - 1000
    mHeight = oFrm.WindowHeight - 1500
    DoCmd.Restore
    DoCmd.Echo True
End Sub
 
Private Sub ResizeFormMax(oFrm As Form)
    DoCmd.Echo False
    Call DoCmd.MoveSize(0, 0, mWidth, mHeight)
    DoCmd.Echo True
End Sub
 
Private Sub ResizeFormSmaller(oFrm As Form)
    DoCmd.Echo False
    Call DoCmd.MoveSize(1000, 2000, 8000, 9000)
    DoCmd.Echo True
End Sub

Bonne suite

[marot_r]

Bonjour Micniv

Merci de ton temps.

Tu vas sans doute me trouver penible mais je ne souhaite pas ajouter de bouton a mes forms. Certains de mes forms sont en mode feuille de donnees et c'est pourquoi je souhaite de gerer avec les evenements du formulaire.

A+

[LedZeppII]

Bonjour René,

Je constate moi aussi des problèmes, lorsqu'on agit sur la taille du formulaire dans l'événement Form_Resize.
Ça ne fonctionne correctement que si je redimensionne le formulaire après la fin de l'événement Form_Resize.
Je fais ça en armant le timer du formulaire, et c'est dans l'événement Form_Timer que je redimensionne le formulaire.

Si tu veux quelque chose de plus souple (réutilisable), je pense que le mieux serait d'utiliser le timer d'un formulaire caché.
Voila ce que j'ai essayé:

Dans un module de code, une sub EnsureNotMaximized qui va déterminer s'il faut redimensionner un formulaire, et qui va s'assurer que le formulaire caché est ouvert:

Code vba :

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
' --------------------------
' Déclarations
' --------------------------
 
#If VBA7 Then
Private Declare PtrSafe Function IsZoomed Lib "user32.dll" (ByVal hWnd As LongPtr) As Boolean
#Else
Private Declare Function IsZoomed Lib "user32.dll" (ByVal hWnd As Long) As Boolean
#End If
 
' --------------------------
' Procédures et fonctions
' --------------------------
 
' Procédure qui détermine s'il faut redimensionner le formulaire passé en argument
Public Sub EnsureNotMaximized(prmForm As Form)
Dim fmUtil As Form
If IsZoomed(prmForm.hWnd) Then
   Set fmUtil = GetUtilForm()
   fmUtil.ScheduleResize prmForm    ' appel procédure publique du formulaire caché
End If
End Sub
 
' Ouvre le formulaire caché si besoin, et retourne une référence au formulaire
Public Function GetUtilForm() As Access.Form
Const CS_FM_NAME = "fmUtilAppli"    ' Nom du formulaire caché
Const CB_FM_WINDOW = acHidden       ' mettre 0 pour déboguer, acHidden en temps normal
Dim bOpenForm As Boolean
 
If Application.CurrentProject.AllForms(CS_FM_NAME).IsLoaded = False Then
    bOpenForm = True
ElseIf Application.Forms(CS_FM_NAME).CurrentView = 0 Then
    bOpenForm = True
End If
 
If bOpenForm Then DoCmd.OpenForm CS_FM_NAME, acNormal, , , , CB_FM_WINDOW
 
Set GetUtilForm = Application.Forms(CS_FM_NAME)
End Function

Dans le formulaire caché:

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
' --------------------------
' Déclarations
' --------------------------
 
' Action à réaliser dans l'événement Timer du formulaire
Enum enmTimerAction
    tmrNOP = 0          ' Aucune
    tmrAdjustMaxSize    ' Ajuster la taille
End Enum
 
' Variable pour mémoriser l'action à réaliser dans l'événement Timer du formulaire
Dim TimerAction As enmTimerAction
' Variable pour sauvegarder la valeur d'intervalle de déclenchement du timer du formulaire
Dim TimerIntervalOld As Long
' Variable pour formulaire cible du redimensionnement
Dim fmFormToResize As Access.Form
 
 
' --------------------------
' Procédures
' --------------------------
 
Public Sub ScheduleResize(prmForm As Form)
   ' Si l'action à réaliser n'est pas déjà définie
   If (TimerAction <> tmrAdjustMaxSize) Then
      ' Définir l'action à exécuter dans l'événement Form_Timer
      TimerAction = tmrAdjustMaxSize
      ' Définir le formulaire à redimensionner
      Set fmFormToResize = prmForm
      ' Fixer la nouvelle valeur du timer
      Me.TimerInterval = 100
   End If
 
End Sub
 
Private Sub ResizeMaxForm(prmForm As Form)
 
    prmForm.Visible = True
    prmForm.SetFocus
    DoCmd.Maximize
    Dim l As Long: l = prmForm.WindowLeft
    Dim t As Long: t = prmForm.WindowTop
    Dim w As Long: w = prmForm.WindowWidth - 300
    Dim h As Long: h = prmForm.WindowHeight - 750
    DoCmd.Restore
    DoCmd.MoveSize 0, 0, w, h
 
End Sub
 
' --------------------------
' Procédure événementielles
' --------------------------
 
Private Sub Form_Load()
TimerIntervalOld = Me.TimerInterval
End Sub
 
Private Sub Form_Timer()
Me.TimerInterval = 0
 
' Si l'action à réaliser est un ajustement de la taille du formulaire
If TimerAction = tmrAdjustMaxSize Then
   ' Ajuster Position/Taille
   ResizeMaxForm fmFormToResize
   ' réinitialiser TimerAction
   TimerAction = tmrNOP
End If
 
' Restorer la valeur du timer
Me.TimerInterval = TimerIntervalOld
 
End Sub

A+

[marot_r]

Merci.

Je regarde cela et je te reviens au plus vite.

A+

[marot_r]

Bon alors grace a votre aide cela a fini par marcher.

Un merci particulier a LedZeppII pour son idee de passer par un autre formulaire.

Ici la solution que j'ai obtenue :

• Au redmensionnement, passe la main a un autre formulaire.
• Cet autre formuliare agit sur le formulaire redimensionne pour retablir sa taille apres un delais de 5 ms.

La fonction pour obtenir la taille de la fenetre a ete trouvee sur internet.

module : mdlFormResize

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
Option Compare Database
Option Explicit
 
Private Declare Function IsZoomed Lib "user32.dll" (ByVal hwnd As Long) As Boolean
 
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long
 
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
 
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
 
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
 
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
Const DIRECTION_VERTICAL = 1
Const DIRECTION_HORIZONTAL = 0
 
Type Rect
    x1 As Long
    y1 As Long
    x2 As Long
    y2 As Long
End Type

Code :

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

1
2
3
4
5
Public Function IsFormMaximized(prmForm As Form) As Boolean
    Dim result As Boolean
    result = IsZoomed(prmForm.hwnd)
    IsFormMaximized = result
End Function

Code :

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

1
2
3
4
5
6
7
8
Public Sub ResizeMaxForm(prmForm As Form)
    Dim f As Form_FrmFormResizer
    Call DoCmd.OpenForm("frmFormResizer", , , , , acHidden)
    Set f = Forms("frmFormResizer")
    f.ResizedFormName = prmForm.Name
    f.TimerInterval = 5
    Set f = Nothing
End Sub

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
Public Function GetMainWindowSize() As Rect
 
    Dim result As Rect
 
    Dim MDIRect As Rect
    Dim lWidthPixels As Long
    Dim lWidthTwips As Long
 
    Dim lHeightPixels As Long
    Dim lHeightTwips As Long
 
    ' Get the screen coordinates and window size of the MDIClient area'
    GetClientRect Application.hWndAccessApp, MDIRect
 
    lWidthPixels = MDIRect.x2 - MDIRect.x1
    lWidthTwips = PixelsToTwips(lWidthPixels, DIRECTION_HORIZONTAL)
 
    lHeightPixels = MDIRect.y2 - MDIRect.y1
    lHeightTwips = PixelsToTwips(lHeightPixels, DIRECTION_VERTICAL)
 
'    MsgBox "Width (Pixels) = " & lWidthPixels & "  Width (Twips) = " & lWidthTwips & _
'     " Height (Pixels) = " & lHeightPixels & "  Height (Twips) = " & lHeightTwips
 
    result.x1 = 0
    result.y1 = 0
    result.x2 = lWidthTwips
    result.y2 = lHeightTwips
 
    GetMainWindowSize = result
End Function

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
Private Function PixelsToTwips(lPixels As Long, lDirection As Long) As Long
 
    Dim lDeviceHandle As Long
    Dim lPixelsPerInch As Long
 
    lDeviceHandle = GetDC(0)
 
    If lDirection = DIRECTION_HORIZONTAL Then
        lPixelsPerInch = GetDeviceCaps(lDeviceHandle, LOGPIXELSX)
    Else
 
        lPixelsPerInch = GetDeviceCaps(lDeviceHandle, LOGPIXELSY)
    End If
 
    lDeviceHandle = ReleaseDC(0, lDeviceHandle)
 
    PixelsToTwips = lPixels * 1440 / lPixelsPerInch
 
End Function

Formulaire cache : frmFormResizer

Code :

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

1
2
3
4
5
6
7
8
Option Compare Database
Option Explicit
 
Dim m_ResizedFormName As String
 
Public Property Let ResizedFormName(prmName As String)
    m_ResizedFormName = prmName
End Property

Code :

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

1
2
3
4
5
6
7
8
9
Private Sub Form_Timer()
 
    If CurrentProject.AllForms(m_ResizedFormName).IsLoaded Then
        Dim f As Form: Set f = Forms(m_ResizedFormName)
        Call ResizeMaxForm(f)
        Me.TimerInterval = 0
    End If
 
End Sub

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
Private Sub ResizeMaxForm(prmForm As Form)
 
    If mdlFormResize.IsFormMaximized(prmForm) Then
 
        Dim mainWindowRect As Rect: mainWindowRect = mdlFormResize.GetMainWindowSize()
        Dim l As Long: l = mainWindowRect.x1
        Dim t As Long: t = mainWindowRect.y1
        Dim w As Long: w = mainWindowRect.x2 - 400
        Dim h As Long: h = mainWindowRect.y2 - 1500
        DoCmd.Restore
 
        If l < 0 Then
            l = 0
            w = w - l
        End If
 
        If t < 0 Then
            t = 0
            h = h - t
        End If
 
        Debug.Print l, t, w, h
        Call prmForm.Move(l, t, w, h)
 
        Debug.Print "Resized"
    End If
 
    Me.Visible = False
End Sub

Formulaire frmTest

Code :

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

1
2
3
4
5
6
Option Compare Database
Option Explicit
 
Private Sub Form_Resize()
    Call mdlFormResize.ResizeMaxForm(Me)
End Sub

A+

[LedZeppII]

Bonjour René,

Merci pour avoir posté ta solution. Elle fonctionne très bien (testée avec Access 2010).

Je voudrai juste attirer ton attention sur un point dans la fonction mdlFormResize.GetMainWindowSize().
Avec ce code...

Code :

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

1
2
    ' Get the screen coordinates and window size of the MDIClient area'
    GetClientRect Application.hWndAccessApp, MDIRect

Tu n'obtiens pas la zone client de la fenêtre MDI, mais la zone client de l'application Access.

Si tu as réellement besoin de la zone client de la fenêtre MDI (en particulier pour un formulaire non indépendant, et donc enfant de la fenêtre MDI), il te faut utiliser le hanlde de la fenêtre MDI en lieu et place de Application.hWndAccessApp.
En parcourant du code que j'ai déjà écrit j'ai trouvé deux méthodes.
Celle d'Arkham46 avec FindWindowEx (Exemple FindWindowEx).
Ou bien avec GetParent(FormulaireNonIndépendant.Hwnd) (exemple GetParent).

A+

[marot_r]

Bonjour LedZeppII

Merci d'avoir valider sous Access 2010.

Quel sera la difference au resultat ?

Tous mes formulaires sont des formulaires normaux (ni independant, ni pop-up).

A+

[LedZeppII]

Bonsoir René,

Quel sera la difference au resultat ?
A+

Avec le rectangle de la zone client de la fenêtre MDI j'obtiens les vraies largeur et hauteur.
Je ne suis pas parasité par l'espace occupé par d'autres éléments de la fenêtre de l'application.
Par exemple à partir d'Acces 2007: le ruban, le volet de navigation (objets tables, requêtes, ...)
Donc en définitive, mes calculs de largeur et hauteur de mon formulaire sont simplifiés et plus justes.

Code Rectangle MDI 2007 :

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
 
+---------------------------------------------+
|                                             |
|  ruban                                      |
|                                             |
+--------+------------------------------------+
|        |             ^                      |
|        |             |                      |
|        |             |                      |
|        |<------ Rectangle MDI ------------->|
|        |             |                      |
| Volet  |             |                      |
|  Nav.  |             |                      |
|        |             |                      |
|        |             |                      |
|        |             |                      |
|        |             |                      |
|        |             |                      |
|        |             |                      |
|        |             v                      |
+---------------------------------------------+

Code Rectangle HwndApp 2007 :

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
 
+---------------------------------------------+
|                      ^                      |
|  ruban               |                      |
|                      |                      |
+--------+-------------|----------------------+
|        |             |                      |
|        |             |                      |
|        |             |                      |
|<--------------- Rectangle HwndApp --------->|
|        |             |                      |
| Volet  |             |                      |
|  Nav.  |             |                      |
|        |             |                      |
|        |             |                      |
|        |             |                      |
|        |             |                      |
|        |             |                      |
|        |             |                      |
|        |             v                      |
+---------------------------------------------+

Voila, c'était juste une remarque, car j'avais vu une différence entre le commentaire et ce que faisait réellement la ligne de code qui suivait, et cela m'avait interpelé

A+

[marot_r]

OK en effet travailler avec la fenetre MDI serait plus juste j'eviterai peut-etre de devoir faire une soustraction (estimee) aux largeurs.

Je vais conserver ma version fonctionnelle et voir si je peux integrer ta modif.

Merci de ton aide.

A+

[marot_r]

Merci de ta remarque et de tes explications.

Je l'ai mise en place et ca fait un travail parfait. La fenetre du formulaire occupe juste toute la place disponible sans bordure inutile.

Voici donc les parties modifiees :

Dans le formulaire frmFormResizer :

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
Private Sub ResizeMaxForm(prmForm As Form)
 
    If mdlFormResize.IsFormMaximized(prmForm) Then
 
        Dim mainWindowRect As Rect: mainWindowRect = mdlFormResize.GetMainWindowSize(Me)
        Dim l As Long: l = mainWindowRect.x1
        Dim t As Long: t = mainWindowRect.y1
        Dim w As Long: w = mainWindowRect.x2
        Dim h As Long: h = mainWindowRect.y2
        DoCmd.Restore
 
        If l < 0 Then
            l = 0
            w = w - l
        End If
 
        If t < 0 Then
            t = 0
            h = h - t
        End If
 
        Debug.Print l, t, w, h
        Call prmForm.Move(l, t, w, h)
        DoEvents
 
        Debug.Print "Resized"
    End If
 
    Me.Visible = False
End Sub

Dans le module mdlFormResize

Code :

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

Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long

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
Public Function GetMainWindowSize(prmForm As Form) As Rect
    'Get the size of the Inner Access window
 
    Dim result As Rect
 
    Dim MDIRect As Rect
    Dim widthInPixel As Long
    Dim widthInTiwps As Long
 
    Dim heightInPixel As Long
    Dim heightInTwips As Long
 
    ' Get the screen coordinates and window size of the MDIClient area'
    'GetClientRect Application.hWndAccessApp, MDIRect
    Call GetClientRect(GetParent(prmForm.hwnd), MDIRect)
 
    widthInPixel = MDIRect.x2 - MDIRect.x1
    widthInTiwps = PixelsToTwips(widthInPixel, DIRECTION_HORIZONTAL)
 
    heightInPixel = MDIRect.y2 - MDIRect.y1
    heightInTwips = PixelsToTwips(heightInPixel, DIRECTION_VERTICAL)
 
'    MsgBox "Width (Pixels) = " & widthInPixel & "  Width (Twips) = " & widthInTiwps & _
'     " Height (Pixels) = " & heightinPixel & "  Height (Twips) = " & heightInTwips
 
    result.x1 = 0
    result.y1 = 0
    result.x2 = widthInTiwps
    result.y2 = heightInTwips
 
    GetMainWindowSize = result
End Function

En plus indirectement cela resoud un probleme de rafraichissement de l'ecran.
Avec le changement de taille Access laissait une bande de l'image de l'ecran en plein page ce qui rendait l'affichage un peu sale.
Maintenant c'est cache :-).

A+