2009/06/28

access2007 フォーム設定:NavigationButtons

デザインビューでの設定とVBAでの設定では挙動が違う場合があった。
移動ボタン:いいえ
 ボタンは消えるが領域が消えない
Me.NavigationButtons = False
 領域ごと消える

非連結フォームによる更新ADO

多少制限があるものの一応動作する。
コマンドでのレコード移動時にrs.Updateしていないが、
フォームが編集モードにある場合での移動は更新されている。
データ競合の場合は、rs.Resyncで最新状態を取得
Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
rsSet
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection

Set rs = Me.Recordset
Set cn = Me.Recordset.ActiveConnection
rs.Close: cn.Close
Set rs = Nothing: Set cn = Nothing
End Sub

Private Sub コマンド0_Click() '閉じる
DoCmd.SetWarnings False'クリップボードに保存するか?とか聞いてくるので付けてみた
DoCmd.Close
DoCmd.SetWarnings True
End Sub

Private Sub rsSet()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim selectSQL As String

selectSQL = "SQLString"
cn.Open = "ConnectionString
rs.CursorLocation = adUseClient
rs.Open selectSQL, cn, adOpenKeyset, adLockOptimistic

Set Me.Recordset = rs
'コントロールのControlSourceは、プロパティで指定済み

Set rs = Nothing: Set cn = Nothing
End Sub

Private Sub コマンド20_Click() '前へ
On Error GoTo err_hnd
Dim rs As New ADODB.Recordset
Set rs = Me.Recordset
If Not Me.CurrentRecord = 1 Then
 rs.MovePrevious
Else
 rs.MoveLast
End If
Set rs = Nothing
Exit Sub
err_hnd:
rsResync
End Sub

Private Sub コマンド21_Click() '次へ
On Error GoTo err_hnd
Dim rs As New ADODB.Recordset
Set rs = Me.Recordset
If Me.CurrentRecord = Me.Recordset.RecordCount Then
 rs.MoveFirst
Else
 rs.MoveNext
End If
Set rs = Nothing
Exit Sub
err_hnd:
rsResync
End Sub

Private Sub コマンド22_Click() '保存
On Error GoTo err_hnd
Dim rs As New ADODB.Recordset
Set rs = Me.Recordset
rs.Update
Me.Refresh
Set rs = Nothing
Exit Sub
err_hnd:
rsResync
End Sub

Private Sub rsResync()
On Error Resume Next
Dim rs As New ADODB.Recordset
Set rs = Me.Recordset
Me.Undo
rs.Resync
Me.Refresh
End Sub

2009/06/20

非連結レポート

Form1でフィルターとソートしてあるRecordSetを印刷する
として、Cloneをレポートで使用。詳細セクションに配置した
コントロール名とRecordSet.Field名は同一とする。

Dim rs As New ADODB.Recordset
Private Sub Report_Open(Cancel As Integer)
Set rs = Forms("Form1").RecordsetClone
rs.Filter = Forms("Form1").Recordset.Filter
rs.Sort = Forms("Form1").Recordset.Sort
End Sub
Private Sub レポートヘッダー_Format(Cancel As Integer, FormatCount As Integer)
rs.MoveFirst ’印刷プレビューするなら先頭移動が必要
End Sub
Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer)
Dim Ctr As Control
For Each Ctr In Me.詳細.Controls
Ctr = rs(Ctr.Name)
Next
rs.MoveNext
If Not rs.EOF Then Me.NextRecord = False
End Sub
Private Sub Report_Unload(Cancel As Integer)
rs.Close: Set rs = Nothing
End Sub

2009/06/15

非連結フォームによる更新削除

[前提条件]
テーブルのフィールド名とフォームのフィールド名が一致
Option Compare Database
Option Explicit
Const cnStr = "接続文字列"

Private Sub Form_BeforeUpdate(Cancel As Integer)'更新確認
If MsgBox("更新しますか?", vbOKCancel) = vbCancel Then Cancel = True: Me.Undo
End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)
'データの競合ポップアップ抑制
If DataErr = 7787 Then
MsgBox "データが競合しています。"
Response = acDataErrContinue
End If
End Sub

Private Sub Form_Open(Cancel As Integer)
Call rsreSet
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim cn As New ADODB.Connection, rs As New ADODB.Recordset
Set cn = Me.Recordset.ActiveConnection
Set rs = Me.Recordset
rs.Close
cn.Close
Set cn = Nothing: Set rs = Nothing
End Sub

Private Sub rsreSet()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
cn.Open cnStr
rs.CursorLocation = adUseClient
rs.Open "SQL文字列", cn, adOpenKeyset, adLockOptimistic
Set Me.Recordset = rs'フィールド名が一致している
Set cn = Nothing
Set rs = Nothing
End Sub

Private Sub コマンド15_Click()'次へ
On Error Resume Next
DoCmd.RunCommand acCmdRecordsGoToNext
End Sub

Private Sub コマンド16_Click()'前へ
On Error Resume Next
DoCmd.RunCommand acCmdRecordsGoToPrevious
End Sub

Private Sub コマンド17_Click()'移動せず更新
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
End Sub

Private Sub コマンド22_Click()'削除
On Error Resume Next
DoCmd.RunCommand acCmdDeleteRecord
End Sub

Private Sub コマンド23_Click()'recordset更新
rsreSet
End Sub