Accessフォームを外部からスクロール

多くの場合Accessフォームにはレコードソースが設定されていて、単票フォームの時は単一レコードが、帳票フォームとデータシートビューの時はレコード一覧が表示されます。後者の場合、フォームの大きさにすべてのレコードが表示しきれない時は右側にスクロールバーが現れてドラッグしたり、マウスホイールを回せば(フォームがアクティブ時)画面がスクロールしてくれます。つまり、対象のフォームに対して直接アクションをしなければなりません。もちろんDoCmd.GoToRecordを実行したりすればその限りではないのですが、この場合はカレントレコードが移動してしまいます。
今回は対象フォームが非アクティブであっても外部からスクロールさせる例を書いてみます。

最終的には以下の図で右側のFrmBの内のボタンをクリックすると、左側のデータシートフォームFrmAがスクロールするようにします。

図1.

以下の記述はAccess 2000での例です。

スクロールさせるFrmAのレコードソースとなるテーブルを作ってある程度のレコードを用意してください (スクロールが出来る程度のレコード数)。
FrmAという名前のフォームを作成して以下のプロパティを設定してください。
```
レコードソース : １．で作成したテーブル名
既定のビュー   : データシート
ビュー設定     : データシート     
スクロールバー : 水平／垂直(デフォルト)
```
FrmAをデザインビューで開いてツールバーの表示(V)→フィールドリスト(L)から、フォームの詳細セクションにドラッグ＆ドロップしてコントロールを配置して表示すると図１のようになると思います。

スクロールを実行するフォームFrmBを作り、以下のようにプロパティを設定してください。

スクロールバー   : なし
レコードセレクタ : なし
移動ボタン       : なし
区切り線         : なし     
(別に設定しなくても問題ないです。見栄えだけのことです)

図１を参考に詳細セクションに１つのテキストボックス、１つのコンボボックス、２つのコマンドボタンを作って以下のようにプロパティを設定してください。

テキストボックス - 名前 : txt0
コンボボックス   - 名前 : cmb0
                   値集合タイプ : 値リスト
                   値集合ソース : 1;2;3;4;・・・;10         (スクロール間隔)
                   入力チェック : はい
コマンドボタン1  - 名前 : cmd_up
                   クリック時 : [イベントプロシージャ]
コマンドボタン2  - 名前 : cmd_down
                   クリック時 : [イベントプロシージャ]

それではコアの部分を実装していきます。今回もあとで使い回しができるようにスクロールを扱うクラスを定義して必要な機能をメソッドで提供します。クラスの仕様はスクロールさせる対象のフォームを Initメソッドで設定して、VerticalMoveメソッドで上下スクロールさせます。この時第一引数で指定した数値分だけ上または下にスクロールさせます。
今回は応用できるので上下のスクロールだけで左右のスクロールは割愛します。

Alt + F11を押下してVBエディタを起動します。ツールバーの挿入(I)→クラスモジュール(C)で新しいクラスモジュールを作成して、F4を押下してプロパティウィンドウからオブジェクト名を CScrollbarとしてください。作成したクラスモジュールに以下を実装してください。

'//クラスモジュール CScrollbar///////////////////////////////////////
'//
Option Compare Database
Option Explicit 

'スクロールバーハンドル取得
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _     
    (ByVal hWnd1 As Long, _     
     ByVal hWnd2 As Long, _     
     ByVal lpsz1 As String, _     
     ByVal lpsz2 As String) As Long     

'スクロールバーウィンドウスタイル取得
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _     
    (ByVal hwnd As Long, _     
     ByVal nIndex As Long) As Long     

Private Const GWL_STYLE = (-16)     
Private Const SBS_VERT = &H1&           '垂直スクロールバー
'Private Const SBS_HORZ = &H0&          '水平スクロールバー
Private Const WS_DISABLED = &H8000000     

'スクロールバーパラメータ取得
Private Declare Function GetScrollInfo Lib "user32" _     
    (ByVal hwnd As Long, _     
     ByVal n As Long, _     
     lpScrollInfo As SCROLLINFO) As Long     

Private Const SB_CTL = 2                '第二引数に指定

'WM_VSCROLLメッセージ送信用
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _     
    (ByVal hwnd As Long, _     
     ByVal wMsg As Long, _     
     ByVal wParam As Long, _     
     ByVal lParam As Long) As Long  '2011-6-22修正     

Private Const WM_VSCROLL = &H115    'メッセージ
'Private Const WM_HSCROLL = &H114     

Private Const SB_THUMBPOSITION = 4  'wParam設定用
'Private Const SB_THUMBTRACK = 5    '同上

'GetScrollInfo関数で使用する構造体
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 Const SIF_RANGE = &H1  'SCROLLINFO構造体 fMaskメンバ設定用
Private Const SIF_PAGE = &H2   '     同上
Private Const SIF_POS = &H4    '     同上

Private vmoFrm As Access.Form '親フォームへの参照


'------------------------------------------------------------------------
'スクロールさせるフォームへの参照取得
Public Sub Init(argoFrm As Access.Form)     
    Set vmoFrm = argoFrm     
End Sub     

'スクロールさせるフォームの現在のビュー確認(フォームがデザインビューでないか)
Private Function IsParentView() As Boolean     
    On Error GoTo ErrRoutine     

    If vmoFrm.CurrentView = 0 Then     
        IsParentView = False     
    Else    
        IsParentView = True     
    End If     
    Exit Function     

ErrRoutine:
    IsParentView = False     
End Function     

'垂直スクロールバーへのハンドル取得
Private Function GetVScrollbarHandle() As Long     
    Dim vlHScbar As Long     

    If Not IsParentView() Then Exit Function     

    'スクロールバーのハンドル取得
    vlHScbar = FindWindowEx(vmoFrm.hwnd, 0&, "ScrollBar", vbNullString)  '(A)
    Do Until vlHScbar = 0     
        If (GetWindowLong(vlHScbar, GWL_STYLE) And _
                              (SBS_VERT Or WS_DISABLED)) = SBS_VERT Then '(B)
            Exit Do     
        End If     

        vlHScbar = FindWindowEx(vmoFrm.hwnd, vlHScbar, "ScrollBar", vbNullString)
    Loop    

    GetVScrollbarHandle = vlHScbar     

End Function     

'垂直スクロール実行
'引数 : arglDist  スクロールさせる距離    
Public Sub VerticalMove(arglDist As Long)     
    Dim vtScInfo    As SCROLLINFO     
    Dim vlHScbar    As Long     
    Dim vlNewPos    As Long     
    Dim vlWParam    As Long     

    'スクロールさせるフォームがなかったりデザインビューの場合は終了
    If Not IsParentView() Then Exit Sub     

    '対象フォームのスクロールバープロパティが水平のみまたはなしの場合は終了
    If vmoFrm.ScrollBars = 0 Or vmoFrm.ScrollBars = 1 Then Exit Sub     

    '垂直スクロールバーハンドル取得
    vlHScbar = GetVScrollbarHandle() '(C)    
    If vlHScbar = 0 Then Exit Sub     

    'GetScrollInfoで取得するスクロールのパラメータ種類の設定
    vtScInfo.cbSize = LenB(vtScInfo)     
    'Page,つまみの位置,範囲を取得
    vtScInfo.fMask = SIF_PAGE Or SIF_POS Or SIF_RANGE 

    'スクロールバーのパラメータ取得
    If GetScrollInfo(vlHScbar, SB_CTL, vtScInfo) = 0 Then '(D)    
        Exit Sub     
    End If     

    '新しいツマミの位置設定
    If (vtScInfo.nPos + arglDist) < vtScInfo.nMin Then  '(E)    
        vlNewPos = vtScInfo.nMin     
    ElseIf (vtScInfo.nPos + arglDist) > _     
        vtScInfo.nMax - IIf(vtScInfo.nPage - 1 > 0, vtScInfo.nPage - 1, 0) Then
        vlNewPos = vtScInfo.nMax _
                      - IIf(vtScInfo.nPage - 1 > 0, vtScInfo.nPage - 1, 0)
    Else    
        vlNewPos = vtScInfo.nPos + arglDist     
    End If     

    'WM_VSCROLLメッセージ送信時に加えるwParamの値作成
    vlWParam = vlNewPos * &H10000 Or SB_THUMBPOSITION '(F)    

    'メッセージ送信
    SendMessage vmoFrm.hwnd, WM_VSCROLL, vlWParam, vlHScbar     
    vmoFrm.Repaint    
End Sub

・宣言部

このクラスの各プロシージャで使用するWin32APIおよび定数・構造体を宣言、およびスクロールさせたいフォームへの参照を保持するメンバ(vmoFrm)の宣言です。Win32APIの宣言についてはここにテキストファイルがあるので興味がある方はダウンロードしてご覧になってください。

・Init Subプロシージャ

引数で指定されたスクロールさせたいフォームへの参照をメンバ変数vmoFrmに代入します。

・IsParentView Functionプロシージャ

Initプロシージャで設定されたフォームのビューがデザインビューでないか、またはオブジェクト自体ないかをチェックするルーチン。

・GetVScrollbarHandle Functionプロシージャ

このプロシージャについて説明するにはSpy++というツールを使うと分かりやすいのですが、これはVisual Studioに付属しているものなので（MSのサイトにあるかどうかはわかりません)結論だけ書きます。

Accessフォームには様々な子ウィンドウがあり、その中でスクロールバーのウィンドウ (コントロールもウィンドウです)はそのクラス名が「Scrollbar」で、これをFindWindowExの第三引数に指定して(A)でスクロールバーのハンドルをvlHScbarに取得しています。ところがスクロールバーには垂直と水平の２つがありクラス名だけではどちらが垂直か判断できません。そこでGetWinodowLongで垂直なスクロールバーにはあるSBS_VERTが設定されているかを確認して(B)、設定されていれば Doループを抜け、設定されていなければZオーダーでクラス名が「Scrollbar」である次のウィンドウのハンドルを取得します。

※ここでいう「クラス名」とはいわゆるオブジェクト指向や「クラスモジュール」のクラスではなく、ウィンドウクラスの意味です。

・VerticalMove Subプロシージャ

このプロシージャで実際にスクロールさせます。 GetVScrollbarHandleで取得したハンドルを使って(C)、GetScrollInfoで現在のスクロールの位置と移動範囲の最大値・最小値、ページ数を取得します(D)。詳しい解説は MSDNでGetScrollInfo関数およびSCROLLINFO構造体を参照してください。

次に取得したスクロールバーのツマミの現在の位置(SCROLLINFO構造体のnPosメンバ)に、このプロシージャの第一引数で指定したarglDistの値を加えて(上にスクロールする場合はマイナス値)、新しい位置をvlNewPosに設定します。この際GetScrollInfoで取得したツマミの範囲内に収まるように位置を調整します(E)。

新しいツマミの位置が決まったのでWM_VSCRLLメッセージを対象フォーム(vmoFrm)に送信するのですが、 wParam、lParamにスクロールするためのパラメータを設定しなければなりません。
新しい位置にスクロールするにはwParamの下位16ビットにSB_THUBPOSION、上位16ビットに新しい位置を設定し(F)、lParamにスクロールバーコントロールのハンドル(vlHScbar)を設定してSendMessegeを実行します。
詳しい説明はMSDNのWM_VSCROLLを参照してください。

なお、Initプロシージャ、VerticalMoveプロシージャ以外は外部に公開する必要がないので Privateにしておきます。

以上でクラス実装ができたので、CScrollbarオブジェクトを使ってFrmBのモジュールに実装していきます。

AccessのFrmBのデザインビューを表示してツールバーから表示(V)→コード(C)で、VBエディタで FrmBのフォームモジュールを表示してください。２つのコマンドボタンのクリック時イベントプロシージャを含めて、以下を記述してください。

'//FrmB フォームモジュール///////////////////////////////
'//
Option Compare Database     
Option Explicit     

'ボタンクリックイベント
Private Sub cmd_up_Click()     
    FormScroll True     
End Sub     

'ボタンクリックイベント
Private Sub cmd_down_Click()     
    FormScroll False     
End Sub     

Private Sub FormScroll(argyUp As Boolean)     
    Dim voScBar          As CScrollbar     

    On Error Resume Next     

    Set voScBar = New CScrollbar     

    voScBar.Init Forms(Me!txt0.Value)     
    voScBar.VerticalMove CLng(IIf(argyUp, -1, 1) * Me!cmb0.Value)     
End Sub

これでテキストボックス(txt0)にスクロールしたいフォーム名(FrmA)、コンボボックスに一度にスクロールする距離を図1のように入力してボタンをクリックするとFrmAがスクロールしてくれると思います。

今回はコマンドボタンのクリックでスクロールさせましたが、MouseWheelイベントがある AccessのバージョンでしたらCScrollbarオブジェクトを使えば同じ感覚で別フォームのスクロールができると思います。

※はっきりいってこんなんできて何がおもろい？と思われる方も多いと思います。書いた私も実は使い道なんて思いつかないですし、たいしたネタもないのでとりあえず余興として書いてみました。