Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Responsable Access

    Avatar de Arkham46
    Profil pro
    Inscrit en
    septembre 2003
    Messages
    5 173
    Détails du profil
    Informations personnelles :
    Localisation : France, Loiret (Centre)

    Informations forums :
    Inscription : septembre 2003
    Messages : 5 173
    Points : 11 571
    Points
    11 571

    Par défaut Positionner un formulaire sous un contrôle



    Pour positionner un formulaire sous un contrôle :
    Code A mettre dans un module : 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
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
     
    Option Compare Database
    Option Explicit
     
    '***************************************************************************************
    '*                                       API                                           *
    '***************************************************************************************
    ' Definition des variables non typees en long pour 32 bits ou longptr pour 64 bits
    ' Les elements des types doivent etre types obligatoirement
    #If VBA7 Then
    DefLngPtr A-Z
    Const PtrNull As LongPtr = 0
    #Else
    DefLng A-Z
    Const PtrNull As Long = 0
    #End If
    #If VBA7 Then
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RectAPI) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function ClientToScreen Lib "user32" (ByVal hwnd As LongPtr, lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As RectAPI, ByVal fuWinIni As Long) As Long
    #Else
    Private Declare Function SetWindowPos Lib "USER32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare Function GetWindowRect Lib "USER32" (ByVal hwnd As Long, lpRect As RectAPI) 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
    Private Declare Function ClientToScreen Lib "USER32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
    Private Declare Function SystemParametersInfo Lib "USER32" _
                         Alias "SystemParametersInfoA" (ByVal uAction As Long, _
                         ByVal uParam As Long, ByRef lpvParam As RectAPI, _
                         ByVal fuWinIni As Long) As Long
    #End If
    '***************************************************************************************
    '*                                       Types                                         *
    '***************************************************************************************
    ' Type Point pour API
    Private Type POINTAPI
        x As Long
        y As Long
    End Type
    Private Type RectAPI
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
    End Type
    '***************************************************************************************
    '*                                    Constantes                                       *
    '***************************************************************************************
    Private Const SWP_NOSIZE = &H1
    Private Const SWP_NOMOVE As Long = &H2
    Private Const SWP_NOZORDER = &H4
    Private Const SWP_SHOWWINDOW = &H40
    Private Const LOGPIXELSY = 90
    Private Const LOGPIXELSX = 88
    Private Const SPI_GETWORKAREA = 48
     
    '---------------------------------------------------------------------------------------
    ' Convertir les Twips en Pixels sur l'axe horizontal
    '---------------------------------------------------------------------------------------
    ' pTwipsX : Valeur à convertir en Twips
    ' Renvoie la valeur convertie en Pixels
    '---------------------------------------------------------------------------------------
     Public Function TwipsToPixelX(pTwipsX As Long) As Long
        Static Mult As Long
        Dim hdc
        If Mult = 0 Then
            hdc = GetDC(0)
            Mult = 1440 / GetDeviceCaps(hdc, LOGPIXELSX)
            ReleaseDC 0, hdc
        End If
        TwipsToPixelX = CLng(pTwipsX / Mult)
    End Function
     
    '---------------------------------------------------------------------------------------
    ' Convertir les Twips en Pixels sur l'axe vertical
    '---------------------------------------------------------------------------------------
    ' pTwipsY : Valeur à convertir en Twips
    ' Renvoie la valeur convertie en Pixels
    '---------------------------------------------------------------------------------------
    Public Function TwipsToPixelY(pTwipsY As Long) As Long
        Static Mult As Long
        Dim hdc
        If Mult = 0 Then
            hdc = GetDC(0)
            Mult = 1440 / GetDeviceCaps(hdc, LOGPIXELSY)
            ReleaseDC 0, hdc
        End If
        TwipsToPixelY = CLng(pTwipsY / Mult)
    End Function
     
    '---------------------------------------------------------------------------------------
    ' Positionne le formulaire pForm par rapport au contrôle pControl
    '---------------------------------------------------------------------------------------
    Public Sub PositionForm(pForm As Access.Form, pControl As Access.Control)
        Dim lParentForm As Access.Form
        Dim lPt As POINTAPI
        Dim lRect As RectAPI
        Dim lScreenRect As RectAPI
        Dim lScrWitdh As Single, lScrHeight As Single
        On Error GoTo Gestion_Erreurs
        ' Vérifie que le formulaire est en fenêtre indépendante
        If Not pForm.PopUp Then
            MsgBox "Le formulaire à positionner doit être en fenêtre indépendante" & _
                        vbCrLf & "(onglet Autre dans les propriétés du formulaire)", vbInformation
            SetWindowPos pForm.hwnd, 0, 0, 0, 0, 0, SWP_NOZORDER Or SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW
            Exit Sub
        End If
        ' Formulaire parent
        Set lParentForm = pControl.Parent
        ' Remonte jusqu'au formulaire si contrôle dans onglets
        If TypeOf lParentForm Is Page Then
            Do
                Err.Clear
                Set lParentForm = lParentForm.Parent
                If Err.Number <> 0 Then Err.Clear: Exit Do
            Loop
        End If
        ' Lit la taille du formulaire à positionner
        Call GetWindowRect(pForm.hwnd, lRect)
        lRect.Right = lRect.Right - lRect.Left + 1
        lRect.Bottom = lRect.Bottom - lRect.Top + 1
        ' Lit la taille de l'écran
        SystemParametersInfo SPI_GETWORKAREA, 0, lScreenRect, 0
        lScrWitdh = lScreenRect.Right - lScreenRect.Left + 1
        lScrHeight = lScreenRect.Bottom - lScreenRect.Top + 1
        ' Position du contrôle de positionnement
        lPt.x = TwipsToPixelX(pControl.Left + lParentForm.CurrentSectionLeft)
        lPt.y = TwipsToPixelY(pControl.Top + pControl.Height + lParentForm.CurrentSectionTop)
        ClientToScreen lParentForm.hwnd, lPt
        Set lParentForm = Nothing
        lRect.Left = lPt.x
        lRect.Top = lPt.y
        ' Doit tenir dans l'écran
        ' Si déborde à droite => décale le formulaire pour qu'il s'affiche entièrement
        If lRect.Left + lRect.Right > lScrWitdh Then
            lRect.Left = lScrWitdh - lRect.Right
        End If
        ' Si déborde en bas => affiche le formulaire au-dessus du contrôle
        If lRect.Top + lRect.Bottom > lScrHeight Then
            lRect.Top = lRect.Top - TwipsToPixelY(pControl.Height) - lRect.Bottom
        End If
        ' Repositionne le formulaire
        Call SetWindowPos(pForm.hwnd, 0, lRect.Left, lRect.Top, lRect.Right, lRect.Bottom, SWP_NOZORDER Or SWP_NOSIZE Or SWP_SHOWWINDOW)
        On Error GoTo 0
        Exit Sub
    Gestion_Erreurs:
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") dans la procédure PositionForm"
     
    End Sub

    Edit 04/06/2016 : module compatible Office 64bits

    Exemple d'utilisation, sur click sur un bouton :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
     
    Private Sub MonBouton_Click()
    DoCmd.OpenForm "FormulaireAPositionner", , , , , acHidden
    PositionForm Forms("FormulaireAPositionner"), Me.UneZoneDeTexte
    End Sub
    Pour un fonctionnement dans un formulaire continu, la zone de texte doit être située dans la même section que le bouton.
    Le formulaire à positionner doit être en fenêtre indépendante (onglet Autres dans ses propriétés).

    Le formulaire à positionner pForm se place sous le contrôle pControl.
    Si le formulaire est trop grand, il est placé au dessus du contrôle.

  2. #2
    Membre expert
    Avatar de alassanediakite
    Homme Profil pro
    Recherche, formation, développement
    Inscrit en
    août 2006
    Messages
    1 530
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 41
    Localisation : Mali

    Informations professionnelles :
    Activité : Recherche, formation, développement

    Informations forums :
    Inscription : août 2006
    Messages : 1 530
    Points : 3 286
    Points
    3 286
    Billets dans le blog
    8

    Par défaut

    Salut
    J'ai tester, ça marche
    Un grand merci à toi Arkham
    Le monde est trop bien programmé pour être l’œuvre du hasard…
    Mon produit pour la gestion d'école: www.logicoles.com

  3. #3
    Nouveau membre du Club
    Homme Profil pro
    Architecte Access
    Inscrit en
    mars 2009
    Messages
    75
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Architecte Access

    Informations forums :
    Inscription : mars 2009
    Messages : 75
    Points : 30
    Points
    30

    Par défaut Infobulle indépendante sous forme de formulaire

    Bonjour,

    C'est magnifique .
    Personnellement je l'utilise à partir du gotfocus d'une zone de texte. Malheureusement le focus passe sur la popup et pour remettre le focus sur le "parent", j'ai quelque peu modifié le code de la procédure PositionForm comme suit :
    (attention à la ligne Set lParentForm = Nothing déplacée)

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    Public Sub PositionForm(pForm As Access.Form, pControl As Access.Control)
    ' ... 
        lParentForm.SetFocus 'donne le focus au formulaire parent.
        Set lParentForm = Nothing ' cette ligne, située à l'origine plus haut, a été déplacée ici
        On Error GoTo 0
        Exit Sub
    Gestion_Erreurs:
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") dans la procédure PositionForm"
    End Sub
    Dans mon cas, le formulaire popup s'appelle "Frm_InfoBulle" et contient une étiquette lbl_infobulle.
    Ce formulaire est chargé au lancement de l'application
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
        DoCmd.OpenForm "Frm_InfoBulle", , , , , acHidden
    Sa procédure d'activation est celle-ci
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
     
    Sub Infobulle(Vu As Boolean, Optional Ctl As Access.Control, Optional Texte As String)
        Forms("Frm_infobulle").Visible = Vu
        If Vu Then
            Forms("Frm_infobulle").lbl_infobulle.Caption = Texte
            PositionForm Forms("Frm_infobulle"), Ctl
        End If
    End Sub
    et son appel est, par exemple, celui-ci

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
        Infobulle True, NomControle, Texte
    et pour la cacher :

    .

    C'est très très intéressant dans un formulaire continu, mais aussi dans d'autres circonstances.
    Merci à vous, Blaise Cacramp.

  4. #4
    Membre du Club
    Profil pro
    Inscrit en
    janvier 2006
    Messages
    137
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : janvier 2006
    Messages : 137
    Points : 68
    Points
    68

    Par défaut

    Bonjour,

    çà fonctionne impeccable, merci beaucoup. Je l'applique à un formulaire qui me sert de menu qui s'ouvre à chaque fois que je clique sur un controle "Action" d'un formulaire continu. Le formulaire-Menu contient des boutons "sélectionner", "modifier", "supprimer", etc.

    Par contre, je souhaiterais que le formulaire s'affiche un peu plus à droite car actuellement le formulaire cache le contrôle "Action" d'autres enregistrements et il faut refermer à chaque fois le menu manuellement pour pouvoir cliquer sur "Action" du dessous.

    Pouvez vous me dire quelles sont les lignes que je dois modifier pour décaler le formulaire vers la droite sans pose de problème au code s'il vous plait ?

  5. #5
    Responsable Access

    Avatar de Arkham46
    Profil pro
    Inscrit en
    septembre 2003
    Messages
    5 173
    Détails du profil
    Informations personnelles :
    Localisation : France, Loiret (Centre)

    Informations forums :
    Inscription : septembre 2003
    Messages : 5 173
    Points : 11 571
    Points
    11 571

    Par défaut

    Citation Envoyé par Jerome_Hej Voir le message
    Bonjour,

    çà fonctionne impeccable, merci beaucoup. Je l'applique à un formulaire qui me sert de menu qui s'ouvre à chaque fois que je clique sur un controle "Action" d'un formulaire continu. Le formulaire-Menu contient des boutons "sélectionner", "modifier", "supprimer", etc.

    Par contre, je souhaiterais que le formulaire s'affiche un peu plus à droite car actuellement le formulaire cache le contrôle "Action" d'autres enregistrements et il faut refermer à chaque fois le menu manuellement pour pouvoir cliquer sur "Action" du dessous.

    Pouvez vous me dire quelles sont les lignes que je dois modifier pour décaler le formulaire vers la droite sans pose de problème au code s'il vous plait ?
    Bonjour,

    Vous pouvez ajouter la largeur du controle.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
    lPt.x = TwipsToPixelX(pControl.Left + pControl.Width + lParentForm.CurrentSectionLeft)

Discussions similaires

  1. Réponses: 0
    Dernier message: 23/09/2009, 17h22
  2. [AC-2003] Formulaire, sous-formulaire et contrôles
    Par Shankara dans le forum IHM
    Réponses: 6
    Dernier message: 15/05/2009, 12h48
  3. Réponses: 1
    Dernier message: 16/04/2008, 10h56
  4. [2000] se positionner dans un sous-formulaire - Seltop
    Par dr_feelgood dans le forum IHM
    Réponses: 3
    Dernier message: 25/08/2007, 05h56
  5. se positionner ds un sous formulaire
    Par nogood1 dans le forum Access
    Réponses: 2
    Dernier message: 22/09/2006, 11h53

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo