Microsoft Access 掲示板

スクロールバーの「位置」を知ることができるプロパティがあります
Form.CurrentSectionTop プロパティ (Access)
このプロパティで調べてみてください

hiroton様
ご返信ありがとうございます。
CurrentSectionTop　は試しましたが、うまくいきませんでした…

スクロールバーを一番上にして、レコードを1に合わせた状態で値を取得すると450
スクロールバーを一番上にして、レコードを13に合わせた状態で値を取得すると5130
となります。

希望は、どのレコードにいてもスクロールバーが同じ位置なら、同じ値が欲しいのです。
（画像で言うとスクロールバーが一番上なので「1」の値が欲しい）

お手数をおかけしますが、よろしくお願い致します。

このプロパティで調べて（Web検索して）みてください
【Access】帳票フォームでRequeryを行ってもレコードの表示位置が変わらないようにする（ほそぼそプログラミング日記さん）

hiroton 様
度々のご返信ありがとうございます。
ただ申し訳ございません、求めているものとは少し違っておりました。

上記の方法で試したところ、たしかにレコードは同じ位置になるのですが、表示位置が一番上にきてしまいます。

スクロールバーの値さえ取得すれば、GoToPageを使用して実行後も同じスクロールバーの位置（画像でいうと6が一番上の位置）にできるのではないかと思い、悩んでおります。

うまく伝えられず申し訳ございません。よろしくお願い致します。

hiroton 様
大変申し訳ございません。上記の方法を不完全な状態で試しておりました。
（curTop = Me.CurrentSectionTop　が抜けていました）

ちゃんとした方法で行ったところ、うまくいきました。

ちなみにスクロールバーの値はやはり取得するのは難しいものでしょうか…？

「直接」は難しいと思います
ただ、左の数字は

    '現在先頭に表示されているレコード番号を取得
    topRecNum = curRecNum - (Int(curTop / Me.Section("詳細").Height) - headerHeight)

で取得可能。右の数字はレコード総数なので

スクロールバーに表示される文字列 = "レコード: " & topRecNum & " / " & Me.Recordset.RecordCount

とすれば同じ内容になると思いますが、これではまずいですか？

hiroton 様
返信遅くなり申し訳ございません。
やはり難しいですか…承知しました。

たしかに上記の式でほぼ取得可能なのですが、場所によって１つずれる現象がございました。
私なりに調べたところ

Int(curTop / Me.Section("詳細").Height)

の部分が原因らしく、
curTop / Me.Section("詳細").Height　の値が「●●.998…」等になる場合、そのまま小数点が切り捨てられてしまい1つずれてしまいます。
ならば

Int((curTop / Me.Section("詳細").Height) + 0.5) 

で、四捨五入すれば良いかなと思ったのですが、そうすると今までOKだった箇所が1つずれたりと、うまく安定してくれません。
curTop / Me.Section("詳細").Height　の値によってずれたりずれなかったりするため、単純にスクロールバーの整数の値を取得できれば確実だなと思い質問しました。

ただずれるとしてもひとつ程度なので、とりあえずはこれで運用していきたいと思います。
ご教授ありがとうございました。

スクロールバーをマウスでつかんだとき出てくるそれをツールチップと呼びますが、ずれとは以下のどのような状態でしょう？

１．「見た目」とツールチップは同じでVBAの結果にずれがある
２．「見た目」とVBAの結果は同じでツールチップにずれがある

（１）の場合コードに不備があるのだと思います（hirotonはリンク先のコードを検証していません）

（２）の場合はスクロールバーが何を基準に数字を出しているのかわからないのでCurrentSectionTopを使った方法では無理なのかもしれません

『「直接」は難しい』についてですが、出来る出来ないで言えば出来ると思います。質問のリンク先で言われているようなことを今の環境に合わせて実装すればいいです。「windows api」「スクロールバー」「ツールチップ」等のキーワードを組み合わせれば情報を得られるでしょう
ただ、キーワードを見てわかるようにほぼACCESSとは関係ない内容になるのでhirotonとしてはこの掲示板でどうこうするつもりはありません

これについて情報が欲しい場合は他の方の回答を待ってください

難しいことに手を出そうとしているようだったのでキーワード（Form.CurrentSectionTop）だけ出せばある程度作れる能力があるのかなと思っていましたが、そうでもなさそうですね

うまくいかないパターンのそれぞれのプロパティの値と実際に見えるレコードの番号、ツールチップの値を提示してください。このような計算において丸め処理（「Int()」や「/」での計算も）は繰り返せば繰り返すほど後々大きな誤差になります

この処理は、理屈を考えれば単純で、「積み上げた積み木を数えるようなもの」なので計算結果で小数点がでるというのが何かちょっと違うなぁと感じます（普通、積み木が3.998個重なっていますとはならない）

リンク先コードでは

    'フォームヘッダー行数を取得
    headerHeight = Int(Me.Section("フォームヘッダー").Height / Me.Section("詳細").Height)

という処理が合って、ここで丸め処理をしているので何か影響してる可能性があります。これが必要な処理なのか考えてみてください。（もしくは上述の通り情報提供してください）

hiroton 様

色々とご説明いただきありがとうございます。
まだまだ勉強不足でございました。

１．「見た目」とツールチップは同じでVBAの結果にずれがある
に該当します。

ツールチップについてはACCESS外の話になるとのことので、また別で考えさせていただきます。

以下、リンク先のコードにそって情報提示致します。

うまくいく場合

ツールチップの値：9/100
実際に見える先頭レコードの番号：9
'カレントレコードを取得
curRecNum = Me.CurrentRecord 　　　　 '値：16
'現在のセクションの上端からフォームの上端までの距離（twip）を取得
curTop = Me.CurrentSectionTop　　　　　 '値： 3180
Me.Section("フォームヘッダー").Height  '値：454
Me.Section("詳細").Height 　　　　　　 '値： 397

'フォームヘッダー行数を取得
headerHeight = Int(Me.Section("フォームヘッダー").Height / Me.Section("詳細").Height)　 '値： Int(454/397)=1
'現在先頭に表示されているレコード番号を取得
topRecNum = curRecNum - (Int(curTop / Me.Section("詳細").Height) - headerHeight)　　　　'値： 16 - (Int(3180 / 397) - 1) = 9
’結果：9　一致

ずれる場合

ツールチップの値：9/100
実際に見える先頭レコードの番号：9

'カレントレコードを取得
curRecNum = Me.CurrentRecord 　　　　 '値：17
'現在のセクションの上端からフォームの上端までの距離（twip）を取得
curTop = Me.CurrentSectionTop　　　　　 '値： 3570
Me.Section("フォームヘッダー").Height  '値：454
Me.Section("詳細").Height 　　　　　　 '値： 397

'フォームヘッダー行数を取得
headerHeight = Int(Me.Section("フォームヘッダー").Height / Me.Section("詳細").Height)　 '値： Int(454/397)=1
'現在先頭に表示されているレコード番号を取得
topRecNum = curRecNum - (Int(curTop / Me.Section("詳細").Height) - headerHeight)　　　　'値： 17 - (Int(3570 / 397) - 1) = 10
’結果：10　ひとつずれる

ご指摘どおり丸め処理がずれていると思います。
うまくいく場合　Int(3180 / 397)　= 8.0100...=8 OK
ずれる場合　　　Int(3570 / 397)　= 8.992...=8 （本当は9の値が欲しい）

どのように修正すればどんな条件でも一致するか悩んでおります。

Windows API を使う方法です。

標準モジュールに下記のコードをコピーしてください。

Option Compare Database
Option Explicit

Declare PtrSafe Function GetScrollInfo Lib "user32" (ByVal hwnd As LongPtr, ByVal n As Long, lpScrollInfo As SCROLLINFO) As Long

#If Win64 Then
    Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
#Else
    Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
#End If

Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As LongPtr
Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

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&

' 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

' GetWindow() Constants
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

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

Public Function fGetScrollBarPos(frm As Form) As Long
    Dim lngret As Long
    Dim sInfo As SCROLLINFO
    
    sInfo.fMask = SIF_ALL
    sInfo.cbSize = Len(sInfo)
    sInfo.nPos = 0
    sInfo.nTrackPos = 0
    
    Dim hWndSB As LongPtr
    hWndSB = fIsScrollBar(frm)
    
    lngret = GetScrollInfo(hWndSB, SB_CTL, sInfo)
    fGetScrollBarPos = sInfo.nPos + 1
End Function

Public Function fIsScrollBar(frm As Form) As LongPtr
    Dim hWnd_VSB As LongPtr
    Dim hwnd As LongPtr
    hwnd = frm.hwnd
    hWnd_VSB = GetWindow(hwnd, GW_CHILD)
                
    Do
        Select Case fGetClassName(hWnd_VSB)
        Case "scrollBar", "NUIScrollBar"
            If GetWindowLongPtr(hWnd_VSB, GWL_STYLE) And SBS_VERT Then
                fIsScrollBar = hWnd_VSB
                Exit Function
            End If
        End Select
        hWnd_VSB = GetWindow(hWnd_VSB, GW_HWNDNEXT)
    Loop While hWnd_VSB <> 0
    
    fIsScrollBar = -1
End Function

Private Function fGetClassName(hwnd As LongPtr)
    Dim strBuffer As String
    Dim lngLen As Long
    Const MAX_LEN = 255
    strBuffer = Space$(MAX_LEN)
    lngLen = GetClassName(hwnd, strBuffer, MAX_LEN)
    If lngLen > 0 Then fGetClassName = Left$(strBuffer, lngLen)
End Function

フォーム上にコマンドボタンを配置して、下記で表示されるようです。

Private Sub コマンド1_Click()
    MsgBox "レコード: " & fGetScrollBarPos(Me) & "/" & Me.Recordset.RecordCount
End Sub

Office2019 64bit で動作確認。

64bit対応に書き換える時間がなかなか取れなかったので回答が遅くなりました。

hatena 様

ご返信ありがとうございます。
上記コードをそのまま試したところ、無事に動作確認が取れました。
わざわざ64bit対応で書いていただき、大変ありがとうございます。

正直コード内容については一読で理解できそうにないので、じっくり読まさせて頂きます。。

下記コードにて検証してみました

Dim curHeight As Long
Dim curTop As Long
Dim oldHeight As Long
Dim oldCurTop As Long

curHeight = IIf(Me.Section(acHeader).Visible, Me.Section(acHeader).Height, 0)
curTop = 0
oldHeight = curHeight
oldCurTop = 0

Debug.Print curTop; curHeight

Me.AllowAdditions = True
DoCmd.GoToRecord , , acFirst
Do Until Me.NewRecord
    curHeight = Me.Section(acDetail).Height
    curTop = Me.CurrentSectionTop
    
    Debug.Print curTop; curHeight; curTop - oldCurTop; curTop - oldCurTop - oldHeight
    
    oldHeight = curHeight
    oldCurTop = curTop
    
    If Me.NewRecord Then Exit Do
    DoCmd.GoToRecord , , acNext
Loop

ヘッダー無し、詳細高さ1.575cmの場合

 0  0 
 0  893  0  0 
 900  893  900  7 
 1800  893  900  7 
 2700  893  900  7 
 3600  893  900  7 

ヘッダー高さ0.975cm、詳細高さ1.575cmの場合

 0  553 
 555  893  555  2 
 1455  893  900  7 
 2355  893  900  7 
 3255  893  900  7 
 4155  893  900  7 

ヘッダー高さ0.6cm、詳細高さ1.575cmの場合

 0  340 
 345  893  345  5 
 1245  893  900  7 
 2145  893  900  7 
 3045  893  900  7 
 3945  893  900  7 

ヘッダー高さ0.801cm、詳細高さ1.575cmの場合

 0  454 
 450  893  450 -4 
 1350  893  900  7 
 2250  893  900  7 
 3150  893  900  7 
 4050  893  900  7 

ヘッダー高さ0.6cm、詳細高さ2cmの場合

 0  340 
 345  1134  345  5 
 1485  1134  1140  6 
 2625  1134  1140  6 
 3765  1134  1140  6 
 4905  1134  1140  6 

ヘッダー高さ0.801cm、詳細高さ2cmの場合

 0  454 
 450  1134  450 -4 
 1590  1134  1140  6 
 2730  1134  1140  6 
 3870  1134  1140  6 
 5010  1134  1140  6 

ヘッダー高さ0.801cm、詳細高さ0.801cmの場合

 0  454 
 450  454  450 -4 
 900  454  450 -4 
 1350  454  450 -4 
 1800  454  450 -4 
 2250  454  450 -4 

うーん、これは予想しない（困った）結果に・・・

hiroton　様

非常に細かくCurrentSectionTopの仕組みまで分析していただきありがとうございます。
15単位で四捨五入され、解像度の話まで発展するとは想像すらしませんでした‥

正確なdpiの取得をしないと成り立たない繊細な動作をしたいわけではなく、
また CurrentSectionTop を取得する際は必ずカレントレコードが表示エリア内に存在している作りにはなっているので
15単位で補正するやり方でいきたいと思います。
（単純にwindows apiを使った手法が一番とは思いますが…）

accessは奥が深いですね。まだまだ勉強不足を痛感させられます。
hatena様 hiroton様 この度はご教授いただきありがとうございました。大変助かりました。