最近はAccessのフォームをタブ形式で作成することが多かったのですが、今回は現場のニーズでウィンドウ形式で開発しています。
要望は、複数のフォームを自分で好きな場所に配置して使いたいというものでした。
好きな場所に配置して使うので、できれば次回起動の際には「好きな場所・好きな配置」通りに表示してくれたほうがユーザビリティが高いと思われます。
そこでユーザーが最後に利用した場所を保存し、次回起動時に保存した場所にフォームを表示するように実装することにします。
最後にフォームを利用した場所とサイズを保存する
設定を保存するテーブルを用意する
フィールド名 | PK | 型 |
ログインアカウント | ★ | テキスト型 |
入力フォーム上 | 長整数型 | |
入力フォーム左 | 長整数型 | |
入力フォーム幅 | 長整数型 | |
入力フォーム高さ | 長整数型 |
システムを利用するログインユーザー毎にレコードを準備します。
今回はこのテーブルに格納されているユーザのみシステムを利用できるという前提となっています。(レコードが存在しない時にユーザーを追加する機能は実装しません)
共通変数・定数を定義する
事前に共通で使う変数と定数を定義しておきます。
'ロード時にログインユーザー名を取得
Private strLogin As String
'画面サイズのデフォルト定義
Private Const FORMWIDTH = 14500
Private Const FORMHEIGHT = 14895
フォームを閉じるときにテーブルに情報を格納する
対象のフォームを閉じるときに、現在ログインしているユーザーのレコードに現在位置・フォームのサイズを保存します。
'------------------------------------------------------------
' 処理内容:閉じる時フォームの現在位置を保存
' 引数:なし
' 戻り値:なし
'------------------------------------------------------------
Private Sub Form_Close()
Dim myDb As Database
Dim myRs As Recordset
Dim intTop As Integer
Dim intLeft As Integer
Dim intWidth As Integer
Dim intHeight As Integer
On Error GoTo Err_Exit
Set myDb = CurrentDb
Set myRs = myDb.OpenRecordset("SELECT * FROM 管理テーブル WHERE ログインアカウント='" & strLogin & "'", dbOpenDynaset)
With myRs
If Not .EOF Then
.MoveFirst
.Edit
'現在のウィンドウ情報を保存する
.Fields("入力フォーム上") = Me.WindowTop
.Fields("入力フォーム左") = Me.WindowLeft
.Fields("入力フォーム幅") = Me.WindowWidth
.Fields("入力フォーム高さ") = Me.WindowHeight
.Update
Else
'データが存在しない場合は何もしない
End If
End With
End_Proc:
Set myRs = Nothing: Close
Set myDb = Nothing: Close
Exit Sub
Err_Exit:
MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical, "Form_Close()"
Set myRs = Nothing: Close
Set myDb = Nothing: Close
End Sub
フォームを指定位置に表示する
フォームを開く時(ロード時)に保存された情報を取得する
対象のフォームを開くときのイベントで管理テーブルからログインユーザーのデータを取得し、MoveSizeメソッドを使ってフォームの位置・サイズを調整します。
Docmd.MoveSizeメソッド
引数:左位置・上位置・幅サイズ・高さサイズ
''------------------------------------------------------------
' 処理内容:フォーム位置リセットボタン
' 引数:左,上,幅,高さ
' 戻り値:なし
'------------------------------------------------------------
Private Sub フォーム位置リセット(intLeft, intTop, intWidth, intHeight)
'フォームを所定の位置に移動
DoCmd.MoveSize intLeft, intTop, intWidth, intHeight
End Sub
ロード時のスクリプトで上記の関数を呼び出します。
''------------------------------------------------------------
' 処理内容:フォームロード時
' 引数:なし
' 戻り値:なし
'------------------------------------------------------------
Private Sub Form_Load()
Dim myDb As Database
Dim myRs As Recordset
Dim intTop As Integer
Dim intLeft As Integer
Dim intWidth As Integer
Dim intHeight As Integer
On Error GoTo Err_Exit
'ログインアカウントデータ取得
strLogin = Environ("username")
Set myDb = CurrentDb
Set myRs = myDb.OpenRecordset("SELECT * FROM 管理テーブル WHERE ログインアカウント='" & strLogin & "'", dbReadOnly)
With myRs
If Not .EOF Then
.MoveFirst
'保存された位置情報を取得
intTop = Nz(.Fields("入力フォーム上"), 0)
intLeft = Nz(.Fields("入力フォーム左"), 0)
intWidth = Nz(.Fields("入力フォーム幅"), 0)
intHeight = Nz(.Fields("入力フォーム高さ"), 0)
'幅と高さが0なら表示できないので初期値をセット
If intWidth = 0 And intHeight = 0 Then
intWidth = FORMWIDTH
intHeight = FORMHEIGHT
End If
'保存された位置情報へフォームを移動する
Call フォーム位置リセット(intLeft, intTop, intWidth, intHeight)
Else
'保存された情報がなければデフォルト位置へ
Call フォーム位置リセット(0, 0, FORMWIDTH , FORMHEIGHT )
End If
End With
End_Proc:
Set myRs = Nothing: Close
Set myDb = Nothing: Close
Exit Sub
Err_Exit:
MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical, "Form_Load()"
Set myRs = Nothing: Close
Set myDb = Nothing: Close
End Sub
念のため規定のサイズにリセットする機能も設ける
ユーザーがフォームのサイズを自由に変更できる仕様なので念のためサイズを初期化できるようボタンを1つ用意しておきました。
''------------------------------------------------------------
' 処理内容:フォーム位置リセットボタン
' 引数:リセットボタンで規定のサイズにリセット
' 戻り値:なし
'------------------------------------------------------------
Private Sub cmd位置リセット_Click()
'位置情報初期化
Call フォーム位置リセット(0, 0, FORMWIDTH , FORMHEIGHT )
End Sub
幅や位置に指定する数値の単位はtwipです。
twipの大きさをcm、ピクセルに変換するとおおよそ以下のような値になります。
- 1cm = 567twip
- 1ピクセル=15twip
コメント