[Sources] Synchroniser 2 sous-formulaires

**stigma** · 03/02/2006, 10h52

Bonjour,
Je voudrais savoir si ma demande est possible avec Access 2003:
J'ai un sous-formulaire comportant des articles et des prévisions de production sur 10 semaines, donc la visualisation se fait par des ascenseurs car il y a beaucoup de données.
Sauf que lorsqu'on regarde les dernières semaines, le libellé des articles n'apparrait plus, évidemment.
J'ai pensé à utiliser DEUX sous-formulaires côte à côte, le premier avec les libellés et le second avec les valeurs, les 2 basés sur la même requête bien sûr.
Seulement lors de l'utilisation de l'ascenseur vertical du second formulaire je voudrais que les libellés défilent automatiquement.
Est-ce possible et qu'elle est la piste à suivre ?
Merci

**loufab** · 03/02/2006, 11h21

Sauf que lorsqu'on regarde les dernières semaines, le libellé des articles n'apparrait plus, évidemment.

Ceci n'est pas normal. Peut-être y a-t'il une lenteur de raffrachissement surtout s'il s'agit d'une requête calculée.

Vérifie avec moins données.

Sinon je ne pense pas que l'on puisse facilement contrôler l'action des ascenseurs (peut-être par les api). A moins de se positionner à chaque déplacement sur un enregistrement. Là il est facile de faire concorder les 2 sous-formulaires.

**stigma** · 03/02/2006, 11h26

Non, si les libellés n'apparaissent pas, c'est juste parce qu'en déplaçant l'ascenseur horizontal, elles sont cachées naturellement, étant complètement à gauche.

J'ai fini par trouver une solution un peu bizarre mais qui fonctionne :
http://www.developpez.net/forums/vie...=colonne+figer

Seulement, celà ne marche plus s'il s'agit d'un sous-formulaire, ou alors il y a un truc qui m'échappe.

**loufab** · 03/02/2006, 15h18

C'est normal ce code fait des appels api avec la référence d'une fenetre (au sens windows) et tu souhaites une action sur un sous-formulaire donc un controle contenu dans cette fenêtre.

Faudrait voir arkham46 pour une réponse, vu que c'est lui le fournisseur du code.

**stigma** · 03/02/2006, 15h21

Ok merci pour l'info

**Arkham46** · 03/02/2006, 15h28

slt

pour le sous-form c'est une fenêtre à part entière (c'est pour ça qu'on ne peut pas en mettre un en mode continu...) donc ça devrais marcher avec un brin de modif (je pense que c'est le screen.activeform qui est un peu hasardeux)

je vais regarder ce soir, je dois avoir une version un peu mieux je crois

**stigma** · 03/02/2006, 15h30

Tu es génial

**Arkham46** · 03/02/2006, 19h41

voilà, celui-là il marche dans un sous-formulaire :

Maintenant c'est une classe, le code est donc à placer dans un module de classe
Sauvegarde la classe sous le nom clScrollForm

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
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
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
 
Option Compare Database
Option Explicit
 
' Constantes
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
Private Const SIF_RANGE = &H1
Private Const SIF_PAGE = &H2
Private Const SIF_POS = &H4
Private Const SIF_ALL = (SIF_RANGE Or SIF_PAGE Or SIF_POS)
Private Const SB_CTL = 2
Private Const SB_VERT = 2
Private Const SB_HORZ = 1
Private Const LOGPIXELSX = 88
' Formulaire
Private Form_Scroll As Form
' Collection contenant les contrôles à figer
Private Fixe_Ctrl As New Collection
' Structure pour API
Private Type ScrollInfo
    cbSize As Long
    fMask As Long
    nMin As Long
    nMax As Long
    nPage As Long
    nPos As Long
    nTrackPos As Long
End Type
Private Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type
'Déclarations d'API
Private Declare Function GetScrollInfo Lib "user32" (ByVal hwnd As Long, ByVal fnBar As Integer, lpsi As ScrollInfo) As Boolean
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 GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
                                       (ByVal hwnd As Long, ByVal lpWindowText As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetDlgCtrlID Lib "user32" (ByVal hwnd As Long) As Long
 
' Handle de la barre de defilement
Private Function GetScrollBarHwnd(ByVal FormhWnd As Long, ByVal BarType As Long) As Long
    Dim lRet As Long
    Dim lClassName As String
    Dim lWindowText As String
    Dim CurrenthWnd As Long
    CurrenthWnd = GetWindow(FormhWnd, GW_CHILD)
    Do Until CurrenthWnd = 0
        Call GetScrollBarHwnd(CurrenthWnd, BarType)
        lClassName = Space(255)
        lRet = GetClassName(CurrenthWnd, lClassName, 255)
        lClassName = left(lClassName, lRet)
        If lClassName = "Scrollbar" Or lClassName = "NUIScrollbar" Then
            If Val(SysCmd(acSysCmdAccessVer)) = 12 Then
                lWindowText = Space(255)
                lRet = GetWindowText(CurrenthWnd, lWindowText, 255)
                lWindowText = left(lWindowText, lRet)
                If lWindowText = "Horizontal" Then
                    lRet = SB_HORZ
                ElseIf lWindowText = "Vertical" Then
                    lRet = SB_VERT
                End If
            Else
                lRet = GetDlgCtrlID(CurrenthWnd)
            End If
            If lRet = BarType Then
                GetScrollBarHwnd = CurrenthWnd
                Exit Function
            End If
        End If
        CurrenthWnd = GetWindow(CurrenthWnd, GW_HWNDNEXT)
    Loop
End Function
 
' Convertir les twips en pixels pour les APIs
Private Function PixelToTwips(X As Long) As Long
    Static mult As Long
    Dim hDC As Long
    If mult = 0 Then
        hDC = GetDC(0)
        mult = 1440 / GetDeviceCaps(hDC, LOGPIXELSX)
        ReleaseDC 0, hDC
    End If
    PixelToTwips = X * mult
End Function
 
Private Sub Class_Terminate()
    Set Form_Scroll = Nothing
End Sub
 
' Sur événement du Timer
Public Sub Form_scroll_Timer()
    Static pos As Long    ' Ancienne position de la barre horizontale
    Static hwnd As Long    ' Handle de la barre horizontale
    Dim lFormParent As String    ' Nom du parent d'un sous-formulaire
' Recherche le nom d'un éventuel parent du formulaire
    On Error Resume Next
    lFormParent = Form_Scroll.Parent.Name
    On Error GoTo fin    ' Ne pas continuer si pas de formulaire actif
    If Screen.ActiveForm.Name = Form_Scroll.Name Or Screen.ActiveForm.Name = lFormParent Then
        ' Si formulaire actif = le formulaire à traiter
        On Error GoTo 0
        If hwnd = 0 Then hwnd = GetScrollBarHwnd(Form_Scroll.hwnd, SB_HORZ)
        pos = ScrollForm(hwnd, pos)
    End If
fin:
End Sub
 
'Déplace les colonnes fixes
Private Function ScrollForm(ByVal hwnd As Long, oldpos As Long) As Double
    Dim ctrl As Control
    Dim SI As ScrollInfo
    Dim delta As Long
    Dim max_col As Double
    Dim lngret As Long
    Dim tabindex As Double
    Dim NameCtrl As Variant
 
    ' Lit les infos de l'ascenseur horizontal
    SI.cbSize = Len(SI)
    SI.fMask = SIF_ALL
    lngret = GetScrollInfo(hwnd, SB_CTL, SI)
    delta = PixelToTwips(SI.nPos) - oldpos
    ' Si on a pas bougé on sort
    If delta = 0 Then GoTo fin
    ' Recherche du contrôle figé le plus à droite de la section détail
    For Each ctrl In Form_Scroll.Section(acDetail).Controls
        On Error Resume Next
        NameCtrl = Fixe_Ctrl.Item(ctrl.Name)
        If Err.Number = 0 Then
            max_col = IIf(ctrl.left + ctrl.Width + delta > max_col, ctrl.left + ctrl.Width + delta, max_col)
        End If
        On Error GoTo 0
    Next
    ' Déplace le focus sur le premier contrôle visible (dans la section détail)
    '   si le focus était sur un contrôle qui devient invisible
    On Error Resume Next
    If Form_Scroll.ActiveControl.left < max_col Then
        NameCtrl = Fixe_Ctrl.Item(Form_Scroll.ActiveControl.Name)
        If Err.Number <> 0 Then
            tabindex = Val(Form_Scroll.ActiveControl.tabindex)
            NameCtrl = ""
            For Each ctrl In Form_Scroll.Section(acDetail).Controls
                On Error Resume Next
                If ctrl.tabindex > tabindex And ctrl.left > max_col Then
                    If Err.Number = 0 Then    ' Si la propriété tabindex existe
                        If NameCtrl = "" Then
                            NameCtrl = ctrl.Name
                        ElseIf ctrl.left < Form_Scroll.Controls(NameCtrl).left Then
                            NameCtrl = ctrl.Name
                        End If
                    End If
                End If
            Next
            Form_Scroll.Controls(NameCtrl).SetFocus
        End If
    End If
    ' Déplace les contrôles pour les rendres "fixes"
    For Each NameCtrl In Fixe_Ctrl
        Form_Scroll.Controls(NameCtrl).left = Form_Scroll.Controls(NameCtrl).left + delta
    Next
    On Error GoTo 0
fin:
    ' Renvoie la position de l'ascenseur
    ScrollForm = PixelToTwips(SI.nPos)
End Function
 
' Initialisation
Public Sub Initialize(pForm As Access.Form)
    Dim ctrl As Control
    ' Formulaire
    Set Form_Scroll = pForm
    ' Ajoute les contrôles contenant <fixe> dans la remarque
    '   dans la collection de contrôles à figer
    For Each ctrl In Form_Scroll.Controls
        If ctrl.Tag Like "*FixeCtrl*" Then
            Fixe_Ctrl.Add ctrl.Name, ctrl.Name
        End If
    Next
End Sub
 
' Ajoute un contrôle fixe à la collection
Public Sub Fixe_Control(ctrl As String)
    On Error Resume Next
    Fixe_Ctrl.Add ctrl, ctrl
End Sub
 
' Retire un contrôle fixe à la collection
Public Sub CancelFixe_Control(ctrl As String)
    On Error Resume Next
    Fixe_Ctrl.Remove ctrl
End Sub

Du coup y a un peu de changements :

La déclaration de la classe en-tête de module du formulaire :

Code :

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

Private FormScroll As New clScrollForm

Préciser le formulaire sur lequel il faut agir :

Code :

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

1
2
3
Private Sub Form_Load()
FormScroll.Initialize Me
End Sub

Commander le scrolling sur l'événement timer :

Code :

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

1
2
3
Private Sub Form_Timer()
FormScroll.Form_scroll_Timer
End Sub

Et détruire la classe à la fermeture du formulaire :

Code :

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

1
2
3
Private Sub Form_Close()
Set FormScroll = Nothing
End Sub

Pour préciser les contrôles à figer :
- soit mettre FixeCtrl dans la remarque
- soit les figer dans le code avec la fonction Fixe_Control("LeNomduContrôle)

On peut arrêter de figer un contrôle avec la fonction CancelFixe_Control("LeNomduContrôle)

Sous Access 2007 : il ne faut pas de mise en forme sur les contrôles :
Dans l'onglet Réorganisation : bouton Supprimer du groupe Mise en forme de contrôle.

Bye.

**Arkham46** · 04/02/2006, 02h56

j'ai fais une ch'tite correction ici :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
            For Each ctrl In Form_Scroll.Section(acDetail).Controls
                On Error Resume Next
                If ctrl.tabindex > tabindex And ctrl.left > max_col Then
                    If Err.Number = 0 Then    ' Si la propriété tabindex existe
                        If NameCtrl = "" Then
                            NameCtrl = ctrl.Name
                        ElseIf ctrl.left < Form_Scroll.Controls(NameCtrl).left Then
                            NameCtrl = ctrl.Name
                        End If
                    End If
                End If
            Next

au cas où il y aurait des contrôles genre rectangle, ligne, ... qui n'ont pas de propriétés TabIndex...

**stigma** · 06/02/2006, 08h51

alors là, bravo, chapeau, respect maximum !
C'est exactement ce qu'il me fallait. Mais comment fais-tu ? c'est donc ça le génie ? Yahoouuuuu ! quelle belle journée ! Merci Seigneur !

**popofpopof** · 21/05/2009, 21h25

BONJOUR

j'ai essayer de fichier ma colonne Operation mais je n'y arrive pas je en trouve pas mon probleme je joint ma base vous pouvez m'aide??

**Arkham46** · 22/05/2009, 07h48

Envoyé par popofpopof

BONJOUR

j'ai essayer de fichier ma colonne Operation mais je n'y arrive pas je en trouve pas mon probleme je joint ma base vous pouvez m'aide??

bonjour,

tu as oublié de mettre un intervalle de minuterie au formulaire, le Form_Timer n'est donc jamais executé

**popofpopof** · 22/05/2009, 08h23

j'ai ajoute 1 a la place du 0 dans minuterie mais j'ai un probleme d'affichage sa ne s'affiche pas bien c'est illisible normal??
je te joint l'imrpression ecran

**Arkham46** · 22/05/2009, 08h36

Envoyé par popofpopof

j'ai ajoute 1 a la place du 0 dans minuterie mais j'ai un probleme d'affichage sa ne s'affiche pas bien c'est illisible normal??
je te joint l'imrpression ecran

Il faut passer les contrôles figés en avant-plan pour qu'ils soient toujours visibles, et mettre un fond blanc à la zone de libellé pour que les autres libellés ne soit pas visibles par dessous.
Ce n'est plus qu'une question de mise en forme.

**popofpopof** · 22/05/2009, 12h36

merci bcp sa marche bcp mieux

**fytsiri** · 26/08/2016, 15h41

Envoyé par popofpopof

merci bcp sa marche bcp mieux

Je suis un peu en retard par rapport à la discussion. Mais j'ai essayé en vain de synchroniser deux sous formulaire.

Peut tu publier popofpopof mettre ton bdd fini sur ce post pour m'aider.

Sinon peut tu faire une exemple sur access 2007 s'il te plait

Je t'en remercie déjà

[Sources] Synchroniser 2 sous-formulaires

Contribuez

Discussions similaires

Partager

Partager