Discussion :

[Mr.Gus]

Salut,
Est-il possible de figer les colonnes dans un formulaire continu ?

[keita]

Tu veux dire en mode feuille de données?
Jamais vu ça en mode continu

[Mr.Gus]

Et ben non, je sais comment çà marche en mode feuille de données mais j'aimerais faire çà en mode continu.

[Maxence HUBICHE]

???
Ben ... elles SONT figées en mode continu !
Tu ne peux pas tirer dessus pour les agrandir me semble-t-il !!!

Ou alors, le vocabulaire utilisé n'est pas approprié ...

[léonardgénie]

Non ; je pense qu'il veut qu'une colone (par ex. à droite de l'écran) reste fixe, alors qu'on peut aller chercher des infos (par ex. à gauche ) qui sont si loin, qu'on ne verrait plus la colonne de gauche.

C'est évidemment par pure mansuétude que je laisse à d'autres le soin de trouver une solutio !

[Mr.Gus]

Pour répondre à ZeMenace :
Figer = Quand on se déplace dans l'écran, la colonne est toujours visible.
Rien à voir avec la taille.
Ex : Je fige ma colonne tout à gauche, mes colonnes s'étalent sur plusieurs écrans, quand je sors de l'écran de départ, ma colonne figée est toujours visible.
Voilà tout

J'suis preneur d'idées.
a+

[Etienne Bar]

A ma connaissance, ce n'est pas posible sauf à utiliser ton formulaire en feuilles de données.

Sauf peut être une bidouille de génie, mais je ne vois vraiment pas.

[Mr.Gus]

Mes respects mon directeur
Je lance un apel à tous les génies.
Un mi-choco au premier qui touve.
a+

[THOGAL]

tu fais deux sous formulaires l'un à coté de l'autre !
celui de gauche sert pour la colonne figée et le second pour les autres colonnes !

il faut juste trouver un code qui intercepte le déplacement dans les enregistrements de celui de droite afin de simuler un scrolling du premier !

:

[Mr.Gus]

Ok Merci pour l'astuce, c'est un peu chiant, j'essayerai quand même.

Tu mérites quand même un smarties.
a+

[Arkham46]

EDIT : Cf ce post :
http://www.developpez.net/forums/sho...31&postcount=8
pour le code mis à jour.

Salut,

C'est résolu mais je répond quand même dans ce post pour pas en ouvrir un nouveau (au cas où les gens utilisent la fonction de recherche... )

Une bidouille pour figer des contrôles en mode formulaire : lire régulièrement la position de l'ascenceur horizontal et déplacer les contrôles figés pour qu'ils restents visibles.

Dans l'évenement timer du formulaire :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub Form_Timer()
 Static pos As Long
 Static hwnd As Long
 On Error GoTo fin
 If Screen.ActiveForm.Name = Me.Name Then
     On Error GoTo 0
     If hwnd = 0 Then hwnd = GetScrollBarHwnd(Me.hwnd)
     pos = ScrollForm(hwnd, pos)
 End If
 fin:
 End Sub

Dans un module à part :

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
Option Compare Database
 Option Explicit
 
 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 WM_VSCROLL = &H115
 Private Const SB_CTL = 2
 Private Const GW_HWNDNEXT = 2
 Private Const GW_CHILD = 5
 Private Const LOGPIXELSX = 88
 
 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 GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch 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 GetScrollInfo Lib "user32" (ByVal hwnd As Long, ByVal fnBar As Integer, lpsi As ScrollInfo) 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
 
 ' Convertir les twips en pixels
 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
 
 'Recherche handle de la barre horizontale
 Function GetScrollBarHwnd(ByVal FormHwnd As Long) As Long
   Dim CurrenthWnd As Long, lngret As Long
   Dim sWindowText As String, sClassname As String
   Dim MyRect As RECT
 
   CurrenthWnd = GetWindow(FormHwnd, GW_CHILD)
 
   Do Until CurrenthWnd = 0
     Call GetScrollBarHwnd(CurrenthWnd)
 
     sWindowText = Space(255)
     lngret = GetWindowText(CurrenthWnd, sWindowText, 255)
     sWindowText = left(sWindowText, lngret)
 
     sClassname = Space(255)
     lngret = GetClassName(CurrenthWnd, sClassname, 255)
     sClassname = left(sClassname, lngret)
 
     If sClassname = "Scrollbar" Then
       lngret = GetClientRect(CurrenthWnd, MyRect)
       If (MyRect.bottom < MyRect.right) Then
         GetScrollBarHwnd = CurrenthWnd
         Exit Function
 
       End If
     End If
 
     CurrenthWnd = GetWindow(CurrenthWnd, GW_HWNDNEXT)
   Loop
 End Function
 
 
 'Déplace les colonnes fixes
 Public 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 min_col As Double
 Dim lngret As Long
 Dim tabindex As Double
 
 SI.cbSize = Len(SI)
 SI.fMask = SIF_ALL
 
 lngret = GetScrollInfo(hwnd, SB_CTL, SI)
 delta = PixelToTwips(SI.nPos) - oldpos
 If delta = 0 Then GoTo fin
 min_col = Screen.ActiveForm.Width
 For Each ctrl In Screen.ActiveForm.Section(acDetail).Controls
   If ctrl.Tag = "fixe" Then
    max_col = IIf(ctrl.left + ctrl.Width + delta > max_col, ctrl.left + ctrl.Width + delta, max_col)
   End If
 Next
 On Error Resume Next
 If Screen.ActiveForm.ActiveControl.Tag <> "fixe" And Screen.ActiveForm.ActiveControl.left < max_col Then
     tabindex = Val(Screen.ActiveForm.ActiveControl.tabindex)
     For Each ctrl In Screen.ActiveForm.Section(acDetail).Controls
       If ctrl.tabindex > tabindex And ctrl.left > max_col Then
         ctrl.SetFocus
         If Err.Number = 0 Then Exit For
       End If
     Next
 End If
 On Error GoTo 0
 For Each ctrl In Screen.ActiveForm.Controls
   If ctrl.Tag = "fixe" Then
     ctrl.left = ctrl.left + delta
   End If
 Next
 fin:
 ScrollForm = PixelToTwips(SI.nPos)
 End Function

Mettez par exemple 100 ms pour le timer et définissez le tag de chaque contrôle à figer à "fixe".
Mettez les colonnes figées en avant-plan et collées les unes aux autres car les autres colonnes ne sont pas masquées.
Les contrôles des sections autres que la section détail peuvent aussi être figés pour garder des boutons de l'en-tête toujours visibles par exemple.
C'est pas très fluide mais de toutes façon c'est pas beaucoup pire que le scrolling d'origine et j'ai pas trouvé mieux!

A plus.