パソコン情報

【Access】テキストに載ってない便利Tips5選

レコードの保存や再クエリするとフォームのデータが先頭に移動するのを防ぐ

 

 

テーブルを直接フォームにして検索や抽出した場合に、VBAなどで、

 

DoCmd.ShowAllRecords

 

をして、再表示させると、レコードが先頭に移動して元のレコードに戻らなければならない時がある。

それを防止ではなく、再度元に戻れるようにする。

 

処理するVBAに下記の内容を加えるとレコードが元に戻る。

 

Dim CR As Integer
CR=Forms!フォームA.CurrentRecord

(再クエリなどの処理)

DoCmd.GoToRecord acDataForm,"フォームA",acGoTo,CR

 

 

 

とりあえず、VBAのエラーを無視する

 

 

Private Sub txt前_Click()

On Error Resume Next

  '前レコードに移動します。

DoCmd.GoToRecord , "", acPrevious

End Sub

 

On Error Resume Next では、エラーが発生するとエラーの発生した次の行から処理を続行します。

 

 

処理中メッセージ

 

処理に時間がかかった時に、「少々お待ちください!」なんていう処理中メッセージ画像がでると親切な場合があります。

 

処理中メッセージを重い処理の間に表示させるために、フォームで「job_wait」というのを作成した。(フォーム画像で「処理中」と固定表示しているだけ)


以前は、それを、開いて、処理が終わったら閉じてという手順で問題なかったが、突然うまく動かなくなった。

答えは、簡単「DoEvents」の一行追加するだけでした。

 

 

Private Sub Form_Open(Cancel As Integer)
Dim cn As New ADODB.Connection

On Error GoTo ErrRtn

Set cn = CurrentProject.Connection

DoCmd.OpenForm "job_wait"
DoEvents    'これが無いとうまく動かなかった。

cn.BeginTrans

DoCmd.OpenQuery "parts_wc_del", acViewNormal
DoCmd.OpenQuery "parts_wc_edit", acViewNormal
cn.CommitTrans

cn.Close: Set cn = Nothing

ExitErrRtn:
DoCmd.Close acForm, "job_wait"
Exit Sub

ErrRtn:
DoCmd.Close acForm, "job_wait"
MsgBox "エラー: " & Err.Description
cn.RollbackTrans
cn.Close: Set cn = Nothing
End Sub

 

 

 

開くときにフォームの位置を決めたい

 

 

Private Sub Form_Open(Cancel As Integer)
DoCmd.MoveSize 14000, 1000
End Sub

 

自由なメモ

Docmd.MoveSize[横][,縦][,幅][,高さ]

 

 

 

レポートをグループごとにページ番号を振りたい

 

同じグループごとにレポートをまとめたい時があります。

例えば、会社ごとにレポートをまとめたい。

A社  1/3 2/3 3/3

B社  1/2 2/2

C社  1/1

D社  1/3 2/3 3/3

のようなレポートの出し方になります。

 

なんで標準で装備されてないのか不思議なくらいな機能ですが、Accessには、標準でできません。テクニックが必要です。

 

(1)まず、レポートページフッターに、非連結のテキストボックスを作成して、名前を「txtGrpPages」にします。

 

(2)レポートのどこでも(グループヘッダーの下にした)いいので、テキストボックスを設置して、コントロールソースに

=[Pages]

といれます。

 

(3)下記のVBAを設置すればOK

 

Option Compare Database
Option Explicit
Dim d As Object ' Dictionary オブジェクト用変数

 

'開くとき

Private Sub Report_Open(Cancel As Integer)
Set d = CreateObject("Scripting.Dictionary")
End Sub

 

'会社名フッターのフォーマット時
Private Sub グループフッター0_Format(Cancel As Integer, FormatCount As Integer)
If Me.Pages = 0 Then
d(Me.メーカー番号.Value) = Me.Page
End If
End Sub

 

'会社名ヘッダーのフォーマット時
Private Sub グループヘッダー1_Format(Cancel As Integer, FormatCount As Integer)
Me.Page = 1
End Sub

 

'ページフッターのフォーマット時
Private Sub ページフッターセクション_Format(Cancel As Integer, FormatCount As Integer)
If Me.Pages > 0 Then
Me.txtGrpPages = Me.Page & " / " & d(Me.メーカー番号.Value)
End If
End Sub