Méthode Requery and Return to Current Row

**morobaboumar** · 20/04/2020, 19h55

Bonsoir membres du forum,
Je viens de tester cette méthode qui ramène le curseur à la ligne en cours d'enregistrement ou de modification.
Seulement, il y a un message d'erreur :

Nom : la ligne active dans Access_8.JPG
Affichages : 379
Taille : 15,9 Ko

Nom : la ligne active dans Access_8.JPG
Affichages : 379
Taille : 15,9 Ko

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
' Our class to hold a couple of Public vars
'Notre classe pour tenir quelques variables publiques
Private SR As clsSetRow
 
Private Sub Form_Load()
Set SR = New clsSetRow
End Sub
 
Private Sub Form_Current()
' This event can be called during the
' Form Load event prior to the init of
' our class so we must test for this.
'Cet événement peut être appelé pendant
'l'Événement de chargement de formulaire avant le début de
'notre classe, nous devons donc tester pour cela.
 
If Not SR Is Nothing Then
    SR.SelTop = Me.SelTop
    SR.CurrentSectionTop = Me.CurrentSectionTop
End If
End Sub
 
 
Private Sub cmdReturn_Click()
On Error GoTo OUMAR
 
Dim OrigSelTop As Long
Dim RowsFromTop As Long
Dim OrigCurrentSectionTop As Long
 
' Must cache the current props because Requery will
' reset them
'Doit mettre en cache les accessoires actuels car Requery
'les réinitialiser
OrigSelTop = SR.SelTop
OrigCurrentSectionTop = SR.CurrentSectionTop
 
' Turn off screen redraw
'Désactiver l'écran de rafraîchissement
Me.Painting = False
 
' Requery the Form
'Raffraichit le formulaire
Me.Requery
 
' Calculate how many rows, if any, the selected
' row was from the top prior to the Requery
' Check if Header is visible or not
'Calcule le nombre de lignes, le cas échéant,
'la ligne était en haut avant la Requery
'Vérifiez si l'en-tête est visible ou non
If Me.Section(acHeader).Visible = True Then
    RowsFromTop = (OrigCurrentSectionTop - Me.Section(acHeader).Height) / Me.Section(acDetail).Height
Else
    RowsFromTop = OrigCurrentSectionTop / Me.Section(acDetail).Height
End If
 
' Setting the SelTop property forces this row to appear
' at the top of the Form. We will subtract the number of rows
' required, if any, so that the original current row remains
' at the original position prior to the Requery.
' First set the current record to the last record.
' This is required due to the method that
' that the Access GUI manages the ScrollBar.
 
'La définition de la propriété SelTop force cette ligne à apparaître
'en haut du formulaire. Nous allons soustraire le nombre de lignes
'obligatoire, le cas échéant, pour que la ligne actuelle d'origine reste
'à la position d'origine avant la Requery.
'Commencez par définir l'enregistrement en cours sur le dernier enregistrement.
'Cela est nécessaire en raison de la méthode
'que l'interface graphique d'accès gère la barre de défilement.
Me.SelTop = Me.RecordsetClone.RecordCount
Me.SelTop = OrigSelTop - RowsFromTop
DoEvents
Me.Painting = True
 
' Now setfocus back to the original row prior to the Requery
'Maintenant, replace la mise au point sur la ligne d'origine avant le Requery
Me.RecordsetClone.AbsolutePosition = Me.CurrentRecord + RowsFromTop - 1
Me.Bookmark = Me.RecordsetClone.Bookmark
 
 
    Exit Sub
 
OUMAR:
    MsgBox Err.Description
End Sub
 
Private Sub NumEnregistrement_Click()
Call cmdReturn_Click
End Sub
 
Private Sub RowNumber_Click()
Call cmdReturn_Click
End Sub
 
Private Sub SelectionUneLigne_AfterUpdate()
' Setting the SelTop property forces this row to appear
' at the top of the Form.
' This is required due to the method that
' that the Access GUI manages the ScrollBar.
 
'La définition de la propriété SelTop force cette ligne à apparaître
'en haut du formulaire.
'Cela est nécessaire en raison de la méthode
'que l'interface graphique d'accès gère la barre de défilement.
Me.SelTop = Me.RecordsetClone.RecordCount
Me.SelTop = Me.SelectionUneLigne.Value
End Sub

Module de classe

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
Option Compare Database
Option Explicit
 
Private mSelTop As Long
Private mCurrentSectionTop As Long
 
Public Property Get SelTop() As Long
SelTop = mSelTop
End Property
 
Public Property Let SelTop(x As Long)
mSelTop = x
End Property
 
 
Public Property Get CurrentSectionTop() As Long
CurrentSectionTop = mCurrentSectionTop
End Property
 
Public Property Let CurrentSectionTop(x As Long)
mCurrentSectionTop = x
End Property

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
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
Option Compare Database
Option Explicit
 
' ****CODE START****
' Place this code in a standard module.
' make sure you do not name the module
' to conflict with any of the functions below.
 
 
'Author:    Stephen Lebans
'           Stephen@lebans.com
'           www.lebans.com
'           Feb.20, 2000
'
'Copyright: Lebans Holdings 1999 Ltd.
'
'Functions: fGetScrollBarPos(frm As Form) As Long
'           fSetScrollBarPos(frm As Form, lngIndex As Long) As Long
'
'Credits:   Dev Ashish, Terry Kreft
'           The Access Web
'           http://www.mvps.org/access/
'
'Why?:      Somebody asked for it!
'
'BUGS:      Let me know!
'           :-)
 
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 Declare Function apiGetScrollInfo _
Lib "user32" Alias "GetScrollInfo" (ByVal hWnd As Long, _
ByVal n As Long, lpScrollInfo As SCROLLINFO) As Long
 
Declare Function apiSetScrollInfo Lib "user32" Alias "SetScrollInfo" _
(ByVal hWnd As Long, ByVal n As Long, lpcScrollInfo As SCROLLINFO, _
ByVal bool As Boolean) As Long
 
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Const GWL_HINSTANCE = (-6)
 
 Private Declare Function SendMessage Lib _
 "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
 ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 
Private Declare Function apiGetClassName Lib "user32" _
    Alias "GetClassNameA" _
    (ByVal hWnd As Long, _
    ByVal lpClassname As String, _
    ByVal nMaxCount As Long) _
    As Long
 
Private Declare Function apiGetParent Lib "user32" _
    Alias "GetParent" _
    (ByVal hWnd As Long) _
    As Long
 
Private Declare Function apiGetWindowLong Lib "user32" _
    Alias "GetWindowLongA" _
    (ByVal hWnd As Long, _
    ByVal nIndex As Long) _
    As Long
 
Private Declare Function apiGetWindow Lib "user32" _
    Alias "GetWindow" _
    (ByVal hWnd As Long, _
    ByVal wCmd As Long) _
    As Long
 
 
'Private Const ACC_MAIN_CLASS = "OMain"
'Private Const ACC_FORM_CLASS = "OForm"
 
Private Const GWL_STYLE = (-16)
' Window Style Flags
Private Const WS_VISIBLE = &H10000000
Private Const WS_VSCROLL = &H200000
 
' Scroll Bar Styles
Private Const SBS_HORZ = &H0&
Private Const SBS_VERT = &H1&
Private Const SBS_SIZEBOX = &H8&
 
 
' ScrollBar Message
Private Const SBM_SETPOS = &HE0
Private Const SBM_GETPOS = &HE1                    '/*not in win3.1 */
Private Const SBM_SETRANGE = &HE2                 '/*not in win3.1 */
Private Const SBM_SETRANGEREDRAW = &HE6            '/*not in win3.1 */
Private Const SBM_GETRANGE = &HE3                  '/*not in win3.1 */
Private Const SBM_ENABLE_ARROWS = &HE4             '/*not in win3.1 */
'#if(WINVER >= 0x0400)
Private Const SBM_SETSCROLLINFO = &HE9
Private Const SBM_GETSCROLLINFO = &HEA
 
' ScrollInfo fMask's
Private Const SIF_RANGE = &H1
Private Const SIF_PAGE = &H2
Private Const SIF_POS = &H4
Private Const SIF_DISABLENOSCROLL = &H8
Private Const SIF_TRACKPOS = &H10
Private Const SIF_ALL = (SIF_RANGE Or SIF_PAGE Or SIF_POS Or SIF_TRACKPOS)
 
' Scroll Bar Constants
Private Const SB_HORZ = 0
Private Const SB_CTL = 2
Private Const SB_VERT = 1
 
' Windows Message Constant
Private Const WM_VSCROLL = &H115
Private Const WM_HSCROLL = &H114
 
' Scroll Bar Commands
Private Const SB_LINEUP = 0
Private Const SB_LINELEFT = 0
Private Const SB_LINEDOWN = 1
Private Const SB_LINERIGHT = 1
Private Const SB_PAGEUP = 2
Private Const SB_PAGELEFT = 2
Private Const SB_PAGEDOWN = 3
Private Const SB_PAGERIGHT = 3
Private Const SB_THUMBPOSITION = 4
Private Const SB_THUMBTRACK = 5
Private Const SB_TOP = 6
Private Const SB_LEFT = 6
Private Const SB_BOTTOM = 7
Private Const SB_RIGHT = 7
Private Const SB_ENDSCROLL = 8
 
 
' GetWindow() Constants
'Private Const GW_HWNDFIRST = 0
'Private Const GW_HWNDLAST = 1
Private Const GW_HWNDNEXT = 2
'Private Const GW_HWNDPREV = 3
'Private Const GW_OWNER = 4
Private Const GW_CHILD = 5
'Private Const GW_MAX = 5
 
 
 
 
 
Public Function fGetScrollBarPos(frm As Form) As Long
' Return ScrollBar Thumb position
' for the Vertical Scrollbar attached to the
' Form passed to this Function.
 
Dim hWndSB As Long
Dim lngret As Long
Dim sInfo As SCROLLINFO
 
    ' Init SCROLLINFO structure
    sInfo.fMask = SIF_ALL
    sInfo.cbSize = Len(sInfo)
    sInfo.nPos = 0
    sInfo.nTrackPos = 0
 
    ' Call function to get handle to
    ' ScrollBar control if it is visible
    hWndSB = fIsScrollBar(frm)
    If hWndSB = -1 Then
        fGetScrollBarPos = False
        Exit Function
    End If
 
    ' Get the window's ScrollBar position
    lngret = apiGetScrollInfo(hWndSB, SB_CTL, sInfo)
    'Debug.Print "nPos:" & sInfo.nPos & "  nPage:" & sInfo.nPage & "  nMax:" & sInfo.nMax
    'MsgBox "getscrollinfo returned " & sInfo.nPos & " , " & sInfo.nTrackPos
    fGetScrollBarPos = sInfo.nPos + 1
 
End Function
 
 
 
Public Function fGetScrollBarPosHZ(frm As Form) As Long
' Return ScrollBar Thumb position
' for the Horizontal Scrollbar attached to the
' Form passed to this Function.
 
Dim hWndSB As Long
Dim lngret As Long
Dim sInfo As SCROLLINFO
 
    ' Init SCROLLINFO structure
    sInfo.fMask = SIF_ALL
    sInfo.cbSize = Len(sInfo)
    sInfo.nPos = 0
    sInfo.nTrackPos = 0
 
    ' Call function to get handle to
    ' ScrollBar control if it is visible
    hWndSB = fIsScrollBarHZ(frm)
    If hWndSB = -1 Then
        fGetScrollBarPosHZ = False
        Exit Function
    End If
 
    'Debug.Print "hwndSB:" & Hex(hWndSB)
    'Debug.Print
 
    ' Get the window's ScrollBar position
    lngret = apiGetScrollInfo(hWndSB, SB_CTL, sInfo)
    Debug.Print "nPos:" & sInfo.nPos & "  nPage:" & sInfo.nPage & "  nMax:" & sInfo.nMax
    'MsgBox "getscrollinfo returned " & sInfo.nPos & " , " & sInfo.nTrackPos
    fGetScrollBarPosHZ = sInfo.nPos + 1
 
End Function
 
 
 
Public Function fSetScrollBarPos(frm As Form, lngIndex As Long) As Long
' Set the Thumb Position for the
' Vertical ScrollBar of the Form passed to
' this Function.
' Remember that we must subtract 1 from the value
' passed to this Fiunction for the desired
' Scrollbar position
 
' *** LIMITED TO 32K ***
' Need to use ScrollInfo to overcome this limit
' Also need to figure out how Access\
' calculates the ScrollBar page size!
 
Dim hWndSB As Long
Dim lngret As Long
Dim LngThumb As Long
 
' Call function to get handle to
' ScrollBar control if it is visible
hWndSB = fIsScrollBar(frm)
If hWndSB = -1 Then
    fSetScrollBarPos = False
    Exit Function
End If
 
 
' Set the value  for the ScrollBar.
' This corresponds to the top most record
' that will be displayed in the Form.
LngThumb = MakeDWord(SB_THUMBPOSITION, CInt(lngIndex - 1))
lngret = SendMessage(frm.hWnd, WM_VSCROLL, ByVal LngThumb, ByVal hWndSB)
 
' Return Success as our new ScrollBar Position
fSetScrollBarPos = lngIndex
 
End Function
 
 
 
Public Function fSetScrollBarPosHZ(frm As Form, lngIndex As Long) As Long
' Set the Thumb Position for the
' Horizontal ScrollBar of the Form passed to
' this Function.
' Remember that we must subtract 1 from the value
' passed to this Function for the desired
' Scrollbar position
 
' *** LIMITED TO 32K ***
' Need to use ScrollInfo to overcome this limit
' Also need to figure out how Access\
' calculates the ScrollBar page size!
 
Dim hWndSB As Long
Dim lngret As Long
Dim LngThumb As Long
 
' Call function to get handle to
' ScrollBar control if it is visible
hWndSB = fIsScrollBarHZ(frm)
If hWndSB = -1 Then
    fSetScrollBarPosHZ = False
    Exit Function
End If
 
 
' Set the value  for the ScrollBar.
' This corresponds to the top most record
' that will be displayed in the Form.
LngThumb = MakeDWord(SB_THUMBPOSITION, CInt(lngIndex - 1))
lngret = SendMessage(frm.hWnd, WM_HSCROLL, ByVal LngThumb, ByVal hWndSB)
 
' Return Success as our new ScrollBar Position
fSetScrollBarPosHZ = lngIndex
 
End Function
 
 
 
 
 
Private Function fIsScrollBar(frm As Form) As Long
' Get ScrollBar's hWnd
Dim hWnd_VSB As Long
Dim hWnd As Long
 
hWnd = frm.hWnd
 
    ' Let's get first Child Window of the FORM
    hWnd_VSB = apiGetWindow(hWnd, GW_CHILD)
 
    ' Let's walk through every sibling window of the Form
    Do
        ' Thanks to Terry Kreft for explaining
        ' why the apiGetParent acll is not required.
        ' Terry is in a Class by himself! :-)
        'If apiGetParent(hWnd_VSB) <> hWnd Then Exit Do
 
        If fGetClassName(hWnd_VSB) = "scrollBar" Then
            If apiGetWindowLong(hWnd_VSB, GWL_STYLE) And SBS_VERT Then
                fIsScrollBar = hWnd_VSB
                Exit Function
            End If
        End If
 
    ' Let's get the NEXT SIBLING Window
    hWnd_VSB = apiGetWindow(hWnd_VSB, GW_HWNDNEXT)
 
    ' Let's Start the process from the Top again
    ' Really just an error check
    Loop While hWnd_VSB <> 0
 
    ' SORRY - NO Vertical ScrollBar control
    ' is currently visible for this Form
    fIsScrollBar = -1
End Function
 
 
 
 
 
 
Private Function fIsScrollBarHZ(frm As Form) As Long
' Get ScrollBar's Horizontal hWnd
Dim hWnd_VSB As Long
Dim hWnd As Long
Dim lngStyle As Long
 
hWnd = frm.hWnd
 
    ' Let's get first Child Window of the FORM
    hWnd_VSB = apiGetWindow(hWnd, GW_CHILD)
 
    ' Let's walk through every sibling window of the Form
    Do
        ' Thanks to Terry Kreft for explaining
        ' why the apiGetParent acll is not required.
        ' Terry is in a Class by himself! :-)
        'If apiGetParent(hWnd_VSB) <> hWnd Then Exit Do
 
        If fGetClassName(hWnd_VSB) = "scrollBar" Then
            lngStyle = apiGetWindowLong(hWnd_VSB, GWL_STYLE)
            If (lngStyle And SBS_SIZEBOX) = False Then
                'If apiGetWindowLong(hWnd_VSB, GWL_STYLE) And SBS_HORZ Then
                 If (lngStyle And 1) = SBS_HORZ Then
                    fIsScrollBarHZ = hWnd_VSB
                    Exit Function
                End If
            End If
        End If
 
    ' Let's get the NEXT SIBLING Window
    hWnd_VSB = apiGetWindow(hWnd_VSB, GW_HWNDNEXT)
 
    ' Let's Start the process from the Top again
    ' Really just an error check
    Loop While hWnd_VSB <> 0
 
    ' SORRY - NO Vertical ScrollBar control
    ' is currently visible for this Form
    fIsScrollBarHZ = -1
End Function
 
 
' From Dev Ashish's Site
' The Access Web
' http://www.mvps.org/access/
 
'******* Code Start *********
Private Function fGetClassName(hWnd As Long)
Dim strBuffer As String
Dim lngLen As Long
Const MAX_LEN = 255
    strBuffer = Space$(MAX_LEN)
    lngLen = apiGetClassName(hWnd, strBuffer, MAX_LEN)
    If lngLen > 0 Then fGetClassName = Left$(strBuffer, lngLen)
End Function
'******* Code End *********
 
 
' Here's the MakeDWord function from the MS KB
Private Function MakeDWord(loword As Integer, hiword As Integer) As Long
MakeDWord = (hiword * &H10000) Or (loword And &HFFFF&)
End Function '***END CODE
 
 
Public Function fSetScrollBarPos1(frm As Form, lngIndex As Long) As Long
 
' *** WARNING***
' ***DO NOT USE THIS FUNCTION YET! ***
 
' Set the Thumb Position for the
' Vertical ScrollBar of the Form passed to
' this Function.
' Remember that we must subtract 1 from the value
' passed to this Fiunction for the desired
' Scrollbar position
 
' Here we are trying to overcome the 32K limit.
' We can get to 64K by rolling our own Unsigned Integer
' vs the VB SignedInteger but I want the
' whole enchelada!<bg>
' I've got it working but I need a bit more time
' tp understand the Logic Access uses to set
' the ScrollBar Page size. It is not always straightforward!!
 
Dim hWndSB As Long
Dim lngret As Long
Dim LngThumb As Long
 
Dim sInfo As SCROLLINFO
 
    ' Init SCROLLINFO structure
    sInfo.fMask = SIF_POS
    sInfo.cbSize = Len(sInfo)
    sInfo.nPos = lngIndex
    sInfo.nTrackPos = 0
 
' Call function to get handle to
' ScrollBar control if it is visible
hWndSB = fIsScrollBar(frm)
If hWndSB = -1 Then
    fSetScrollBarPos1 = False
    Exit Function
End If
 
 
' Set the value  for the ScrollBar.
' This corresponds to the top most record
' that will be displayed in the Form.
If lngIndex >= 65536 / 2 Then lngIndex = (65536 / 2) - lngIndex
LngThumb = MakeDWord(SB_THUMBPOSITION, CInt(lngIndex - 1))
 
 
lngret = apiSetScrollInfo(hWndSB, SB_CTL, sInfo, True)
DoEvents
'lngRet = SendMessage(hWndSB, SBM_SETPOS, lngIndex, ByVal True)
'lngRet = SendMessage(frm.hWnd, WM_VSCROLL, ByVal SB_ENDSCROLL, ByVal hWndSB)
 
' this one below works
'lngRet = SendMessage(frm.hWnd, WM_VSCROLL, ByVal LngThumb, ByVal 0&)
 
 
' Return Success as our new ScrollBar Position
fSetScrollBarPos1 = lngIndex
 
End Function
 
 
Public Function fQuery(garbage As Variant) As Long
' Return ScrollBar Thumb position
' for the Vertical Scrollbar attached to the
' Form passed to this Function.
 
 
 
Const SB_BOTTOM = 7
 
 
On Error GoTo Exit_Query
Dim hWndSB As Long
Dim lngret As Long
Dim sInfo As SCROLLINFO
 
Dim frm As Form
 
Set frm = Screen.ActiveForm
 
    ' Init SCROLLINFO structure
    sInfo.fMask = SIF_ALL
    sInfo.cbSize = Len(sInfo)
    sInfo.nPos = 0
    sInfo.nTrackPos = 0
 
    ' Call function to get handle to
    ' ScrollBar control if it is visible
    hWndSB = fIsScrollBar(frm)
    If hWndSB = -1 Then
        fQuery = -1
        Set frm = Nothing
        Exit Function
    End If
 
 
    'lngRet = SendMessage(frm.hWnd, WM_VSCROLL, SB_BOTTOM, 0&)
 
    ' Get the window's ScrollBar position
    lngret = apiGetScrollInfo(hWndSB, SB_CTL, sInfo)
    'Debug.Print "nPos:" & sInfo.nPos & "  nPage:" & sInfo.nPage & "  nMax:" & sInfo.nMax
    'MsgBox "getscrollinfo returned " & sInfo.nPos & " , " & sInfo.nTrackPos
    'fQuery = sInfo.nPos + 1
    fQuery = sInfo.nMax
    Debug.Print "MAX RECS:" & sInfo.nMax
 
' Set the value  for the ScrollBar.
' This corresponds to the top most record
' that will be displayed in the Form.
'LngThumb = MakeDWord(SB_THUMBPOSITION, CInt(lngIndex - 1))
'lngRet = SendMessage(frm.hWnd, WM_VSCROLL, ByVal LngThumb, ByVal hWndSB)
 'lngRet = SendMessage(frm.hWnd, WM_VSCROLL, SB_BOTTOM, 0&)
 
 
End_Query:
 
Set frm = Nothing
Exit Function
 
Exit_Query:
 
fQuery = -1
Resume End_Query
 
End Function

J'aimerais adapter les codes à mon cas. Sollicite votre aide.
Encore une fois désolé des erreurs commises.
- Pièces jointes du fichier d'origines.
Cordialement.

**marot_r** · 20/04/2020, 20h01

Bonjour.

Sur quelle ligne as-tu l'erreur ?

A+

**Zekraoui_Jakani** · 20/04/2020, 20h08

Ce genre de message apparaît le plus souvent dans 2 cas:

Avec "Option Explicit", VBA détecte une variable qui n'a pas été définie via "Dim ou Public"
Utilisation de "If" sans "End If" ou de "With" sans "End With", ou de "For" sans "Next" … etc

Lancez votre code avec un "Break" pour localiser l'erreur via la touche F8 (step by step)

**morobaboumar** · 23/04/2020, 20h01

Bonsoir membres du forum,
bonsoir marot_r et Zekraoui_Jakani,
Merci infiniment.
Grâce à vos interventions j'ai pu trouver qain de cause à ma recherche qui est en rapport avec ici
https://www.developpez.net/forums/d2...mande-su-code/
Cordialement.

Méthode Requery and Return to Current Row [AC-2013]

VBA Access

Vue hybride

Discussions similaires

Partager

Partager