FC2ブログ

スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

Form_Delete 以降のイベント 


ある QA で、

Private Sub Form_AfterDelConfirm(Status As Integer)
  MsgBox "Form_AfterDelConfirm"
End Sub

Private Sub Form_BeforeDelConfirm(Cancel As Integer, Response As Integer)
  MsgBox "Form_BeforeDelConfirm"
End Sub

Private Sub Form_Delete(Cancel As Integer)
  MsgBox "Form_Delete"
End Sub

と、確認用 MsgBox を記述してみたが、Form_Delete 以降のイベントが発生しない
(Form_BeforeDelConfirm / Form_AfterDelConfirm の MsgBox が表示されない)

という事がありました。
過去記事でも、削除の操作を更新操作に置換えるために上記イベントを使っていました。

どのような構成にすると、イベントは発生しなくなるんだろうか・・・・
これを考えてみました。
また、実際には子(サブ)で削除されたタイミングで、親(メイン)の表示を変更したいという事で、
自力で処理するようにしてみてはどうだろうか・・・・というものも・・・

確認するフォームは親子(メイン/サブ)構成のフォームで、
親(メイン):非連結 子(サブ)の合計を表示するもの
子(サブ):連結の帳票フォーム

kEnt123  kEnt123_d
確認のパターンは以下の6つ  以下()内の記述は(親フォーム名/子フォーム名)
0)イベント確認  (F_T0M / F_T0)
1)クラス 改良前  (F_T1M / F_T1)
2)自力 改良前  (F_T2M / F_T2)
3)クラス 改良後  (F_T3M / F_T3)
4)自力 改良後  (F_T4M / F_T4)
5)クラス 改良その2  (F_T5M / F_T5)

なお、上記画像はフォーム「F_ALL」で、オプショングループで対象サブフォームを切り替えるもの

確認操作は、
・サブフォームにレコードを追加して
・レコードセレクタを使って
・「Delete」キーで削除してみる
という流れになります。
 
Form_Delete 以降が呼ばれない・・・・
これ、単純に考えると、Form_Delete のパラメータ Cancel に True を設定することで
以降のイベントは発生しないようですが、Cancel を True に設定しているわけではない。
考えられるのは、Form_Delete のイベントを誰かが検知して Cancel = True としているのでは・・・
考えやすいのは、クラスを作って、そのクラスの中でイベントを取り込んで・・・・
処理を統一したいとか・・・の場合、クラスを作ってやると各フォームでの記述は見やすくなりますね。
また、VBAで直にレコードを削除した時には Form_Delete は呼ばれないようです。
自力で削除した後で、Form_Delete を呼び出す・・・・これは結構考えにくいのでしょうか。
クラス側から Private Sub Form_Delete(Cancel As Integer) を呼び出せなかった??
同じフォーム内で自力削除して、Form_Delete を呼び出す・・・・
これだったら、Form_Delete のタイミングを使いたいってことにはならない・・・・と思います。

連結表示する為のテーブル「T1」を用意します。
an:オートナンバー
商品名:テキスト型
単価:通貨型(書式:通貨)
数量:通貨型(書式:数値)

フォームウィザードを使って、表形式で作成します。
「単価*数量」表示用のテキストボックスを作成し、コントロールソースを =[単価]*[数量] とします。
総合計表示用のテキストボックス「txt1」をヘッダ部分に作成し、
コントロールソースを =Sum([単価]*[数量]) とします。
「an」と上記2つのテキストボックスは表示だけで良いので、
「編集ロック」を「はい」、「使用可能」を「いいえ」に変更します。
サブフォーム用フォームの見栄えはこれで完了です。(もうチョッとあるかも)

上記フォームをサブフォームとする親フォームをデザインから作成します。
何行目を削除するか・・・・
 これを指定するテキストボックス「txt0」コマンドボタン「btn1」を左側上に
サブフォームの総合計を表示するものを右側上に
(コントロールソースでサブフォームの総合計「txt1」を参照するように)

※ 実際の QA では、サブフォームで削除した時、親フォームの関数を呼び出し、
 その関数内で DSum 結果をテキストボックスに設定・・・・という流れでしたが、今回はこれで

サブフォームコントロール「FSUB」を配置し、ソースオブジェクトにサブ用フォームを指定
これで、親(メイン)フォームのベースは完了です。

親(メイン)フォームへのVBA記述は共通です。
Private Sub btn1_Click()
  If (IsNull(Me.txt0)) Then Exit Sub
  With Me.FSUB.Form.RecordsetClone
    If (Me.txt0 > .RecordCount) Then Exit Sub
    .AbsolutePosition = Me.txt0 - 1
    CurrentProject.Connection.Execute "DELETE * FROM T1 WHERE an = " & .Fields("an")
    Call Req
  End With
End Sub

Public Sub Req()
'  Me.FSUB.Form.Requery
  Me.FSUB.Requery
End Sub

何行目の削除は、何行目・・・・の「an」を求めて、自力削除。
その後、サブフォームからも呼ばれる可能性のあるサブフォームの再クエリを・・・・

※ このサブフォームの再クエリで、
  Me.FSUB.Requery
とすると表示を先頭に戻すことなく、再クエリ動作させることが出来るようです。
通常(?)は
'  Me.FSUB.Form.Requery
の方だと思います。


0)イベント確認  (F_T0M / F_T0)

ここでは、イベントの発生を確認してみます
サブフォームに記述したのは以下
Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  If (Me.Parent.Name = "") Then
    Cancel = True
  End If
End Sub

Private Sub Form_AfterDelConfirm(Status As Integer)
  MsgBox "Form_AfterDelConfirm"
End Sub

Private Sub Form_BeforeDelConfirm(Cancel As Integer, Response As Integer)
  MsgBox "Form_BeforeDelConfirm"
End Sub

Private Sub Form_Current()
'  MsgBox "Form_Current"
End Sub

Private Sub Form_Delete(Cancel As Integer)
  MsgBox "Form_Delete"
'  Call Me.Parent.Req
End Sub

 
起動時、サブフォームとして組み込まれていなければ立ち上がらないようにしておいて・・・
各イベントで MsgBox 表示するように・・・
Access さんからの「○○件削除しますか」メッセージは、Form_BeforeDelConfirm 後ですよね。

1)クラス 改良前  (F_T1M / F_T1)

誰かが Form_Delete のイベントを検知して、別途処理しているのでは・・・・
ということで、クラスの構成を作ってみました。
※ 一応、回答してみたのはこの1)と2)になりますが、新規行が選ばれていた場合正常に動きません。
 新規行も選ばれていた場合でも動作するものにしたのが、3)4)になります。
 なので、1)と3)、2)と4)は大差ありません。

クラス「clsFrm」として記述したのは以下
Private Const EVENT_PROCEDURE As String = "[EVENT PROCEDURE]"
Private WithEvents frm As Form
Private iCount As Long
Private bDel As Boolean

Private Sub Class_Initialize()
  Set frm = CodeContextObject
  frm.OnDelete = EVENT_PROCEDURE
  iCount = -1
  bDel = False
End Sub

Private Sub Class_Terminate()
  Set frm = Nothing
End Sub

Private Sub frm_Delete(Cancel As Integer)
  Dim i As Long

  DoCmd.CancelEvent

  If (frm.SelHeight < 1) Then Exit Sub
  If (iCount < 1) Then iCount = frm.SelHeight
  If (iCount = frm.SelHeight) Then
    bDel = MsgBox(frm.SelHeight & "件 削除しますか?" _
        , vbQuestion + vbYesNo, "確認") = vbYes
  End If
  iCount = iCount - 1
  If (iCount = 0) Then
    If (bDel) Then
      With frm.Recordset
        For i = 1 To frm.SelHeight
          .Delete
          .MoveNext
        Next
      End With
      frm.SelHeight = 0
    End If
    bDel = False
  End If
End Sub

 
クラスを New された時点で、どのフォームで・・・・を覚えておき、
そのフォームの「レコード削除時」( Delete )イベントを受け取るようにします。

frm_Delete は選択されたレコードセレクタ数分呼ばれます。(新規行分除く)
サブフォームで記述した Form_Delete と、クラスで記述した frm_Delete がどの順で呼ばれるか・・・
これを分かりやすくするために、最初でメッセージを出して、最後で削除処理するようにしています。
また、変数 iCount は何をやっているのか説明しなくても読めばわかるかな・・・・って

  DoCmd.CancelEvent
としているのは、Accessさんが削除処理している間、そのレコードをいじるとエラーになって・・・
また、最後に呼ばれた frm_Delete のタイミングでレコードをいじりたい・・・
Cancel = True で戻る前にやりたい!!。
CancelEvent なら発行した時点で Cancel 動作させることが出来るのでは・・・
で、やってみたら Accessさんに怒られることもなく、できてしまった。
※ Cancel = True で戻るパターンは、後述5)にて

サブフォームに記述したのは以下
Dim frm As clsFrm

Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  If (Me.Parent.Name = "") Then
    Cancel = True
  End If
End Sub

Private Sub Form_AfterDelConfirm(Status As Integer)
  MsgBox "Form_AfterDelConfirm"
End Sub

Private Sub Form_BeforeDelConfirm(Cancel As Integer, Response As Integer)
  MsgBox "Form_BeforeDelConfirm"
End Sub

Private Sub Form_Current()
'  MsgBox "Form_Current"
End Sub

Private Sub Form_Delete(Cancel As Integer)
  MsgBox "Form_Delete"
'  Call Me.Parent.Req
End Sub

Private Sub Form_Load()
  Set frm = New clsFrm
End Sub

'Private Sub Form_Close()
'  Set frm = Nothing
'End Sub

 
ここで、注意する箇所が1つ。
サンプル上ではコメントにしましたが、
'Private Sub Form_Close()
'  Set frm = Nothing
'End Sub
部分。
2003 / 2007 では正常に処理されますが、2000 では Form_Close からAccessさんに戻った時に
Accessさんがエラー終了してしまいます。
Form_Close を Form_Unload に変更しても同様でした。
クラスの 
Private Sub Class_Terminate()
  Set frm = Nothing
End Sub
を動かしたいためなんですが・・・・
フォームを閉じただけでは、Class_Terminate は呼ばれないようです。
(確認の仕方が悪かったのかも??)
そもそも、Set frm = Nothing を気にしなくても良い???

 
2)自力 改良前  (F_T2M / F_T2)

ここでは、Form_Delete 発生条件である「Delete」キーのイベントを取り込んで、
Accessさんに削除処理自体をさせない・・・・
削除処理自体がなくなるので、1)のようなクラスを作っていても動かないはず・・・

サブフォームに記述したのは以下
Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  If (Me.Parent.Name = "") Then
    Cancel = True
  End If
End Sub

Private Sub Form_AfterDelConfirm(Status As Integer)
  MsgBox "Form_AfterDelConfirm"
End Sub

Private Sub Form_BeforeDelConfirm(Cancel As Integer, Response As Integer)
  MsgBox "Form_BeforeDelConfirm"
End Sub

Private Sub Form_Current()
'  MsgBox "Form_Current"
End Sub

Private Sub Form_Delete(Cancel As Integer)
  MsgBox "Form_Delete"
'  Call Me.Parent.Req
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  Dim i As Long

  Select Case KeyCode
    Case vbKeyDelete
      If (Me.SelHeight < 1) Then Exit Sub
      KeyCode = 0
      If (MsgBox(Me.SelHeight & "件 削除しますか?" _
          , vbQuestion + vbYesNo, "確認") = vbYes) Then
        With Me.Recordset
          For i = 1 To Me.SelHeight
            .Delete
            .MoveNext
          Next
        End With
        Me.SelHeight = 0
        Call Me.Parent.Req
      End If
  End Select
End Sub

 

3)クラス 改良後  (F_T3M / F_T3)

1)の改良版で、レコードセレクタで選択した中に新規行があっても動くように・・・
また、メッセージの表示タイミングを、最後に呼ばれた時に変更してみました。

クラス「clsFrmKai」として記述したのは以下
Private Const EVENT_PROCEDURE As String = "[EVENT PROCEDURE]"
Private WithEvents frm As Form
Private iCount As Long
Private bNew As Boolean

Private Sub Class_Initialize()
  Set frm = CodeContextObject
  frm.OnDelete = EVENT_PROCEDURE
  iCount = -1
  bNew = False
End Sub

Private Sub Class_Terminate()
  Set frm = Nothing
End Sub

Private Sub frm_Delete(Cancel As Integer)
  Dim i As Long

  DoCmd.CancelEvent

  If (frm.SelHeight < 1) Then Exit Sub
  If (iCount < 1) Then iCount = frm.SelHeight
  If (iCount = frm.SelHeight) Then
    bNew = ((frm.SelTop - 1) + frm.SelHeight) > frm.Recordset.RecordCount
    If (bNew) Then iCount = iCount - 1
  End If
  iCount = iCount - 1
  If (iCount = 0) Then
    If (MsgBox(frm.SelHeight + bNew & "件 削除しますか?" _
        , vbQuestion + vbYesNo, "確認") = vbYes) Then
      With frm.Recordset
        For i = 1 To frm.SelHeight + bNew
          .Delete
          .MoveNext
        Next
      End With
      frm.SelHeight = 0
    End If
  End If
End Sub

 

サブフォームに記述したのは以下
Dim frm As clsFrmKai

Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  If (Me.Parent.Name = "") Then
    Cancel = True
  End If
End Sub

Private Sub Form_AfterDelConfirm(Status As Integer)
  MsgBox "Form_AfterDelConfirm"
End Sub

Private Sub Form_BeforeDelConfirm(Cancel As Integer, Response As Integer)
  MsgBox "Form_BeforeDelConfirm"
End Sub

Private Sub Form_Current()
'  MsgBox "Form_Current"
End Sub

Private Sub Form_Delete(Cancel As Integer)
  MsgBox "Form_Delete"
'  Call Me.Parent.Req
End Sub

Private Sub Form_Load()
  Set frm = New clsFrmKai
End Sub

'Private Sub Form_Close()
'  Set frm = Nothing
'End Sub

 

4)自力 改良後  (F_T4M / F_T4)

サブフォームに記述したのは以下
Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  If (Me.Parent.Name = "") Then
    Cancel = True
  End If
End Sub

Private Sub Form_AfterDelConfirm(Status As Integer)
  MsgBox "Form_AfterDelConfirm"
End Sub

Private Sub Form_BeforeDelConfirm(Cancel As Integer, Response As Integer)
  MsgBox "Form_BeforeDelConfirm"
End Sub

Private Sub Form_Current()
'  MsgBox "Form_Current"
End Sub

Private Sub Form_Delete(Cancel As Integer)
  MsgBox "Form_Delete"
'  Call Me.Parent.Req
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  Dim i As Long
  Dim b As Boolean

  Select Case KeyCode
    Case vbKeyDelete
      If (Me.SelHeight < 1) Then Exit Sub
      KeyCode = 0
      b = ((Me.SelTop - 1) + Me.SelHeight) > Me.Recordset.RecordCount
      If ((Me.SelHeight + b) = 0) Then Exit Sub
      If (MsgBox(Me.SelHeight + b & "件 削除しますか?" _
          , vbQuestion + vbYesNo, "確認") = vbYes) Then
        With Me.Recordset
          For i = 1 To Me.SelHeight + b
            .Delete
            .MoveNext
          Next
        End With
        Me.SelHeight = 0
        Call Me.Parent.Req
      End If
  End Select
End Sub

 

5)クラス 改良その2  (F_T5M / F_T5)

このクラスでは、frm_Delete で Cancel = True を返すようにし、
削除操作は「タイマ時」を利用するように・・・・

クラス「clsFrmKai2」として記述したのは以下
Private Const EVENT_PROCEDURE As String = "[EVENT PROCEDURE]"
Private WithEvents frm As Form
Private iCount As Long
Private bNew As Boolean

Private Sub Class_Initialize()
  Set frm = CodeContextObject
  frm.OnTimer = EVENT_PROCEDURE
  frm.OnDelete = EVENT_PROCEDURE
  iCount = -1
  bNew = False
End Sub

Private Sub Class_Terminate()
  Set frm = Nothing
End Sub

Private Sub frm_Timer()
  Dim i As Long

  frm.TimerInterval = 0
  With frm.Recordset
    For i = 1 To frm.SelHeight + bNew
      .Delete
      .MoveNext
    Next
  End With
  frm.SelHeight = 0
End Sub

Private Sub frm_Delete(Cancel As Integer)

  Cancel = True

  If (frm.SelHeight < 1) Then Exit Sub
  If (iCount < 1) Then iCount = frm.SelHeight
  If (iCount = frm.SelHeight) Then
    bNew = ((frm.SelTop - 1) + frm.SelHeight) > frm.Recordset.RecordCount
    If (bNew) Then iCount = iCount - 1
  End If
  iCount = iCount - 1
  If (iCount = 0) Then
    If (MsgBox(frm.SelHeight + bNew & "件 削除しますか?" _
        , vbQuestion + vbYesNo, "確認") = vbYes) Then
      frm.TimerInterval = 10
    End If
  End If
End Sub

 

サブフォームに記述したのは以下
Dim frm As clsFrmKai2

Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  If (Me.Parent.Name = "") Then
    Cancel = True
  End If
End Sub

Private Sub Form_AfterDelConfirm(Status As Integer)
  MsgBox "Form_AfterDelConfirm"
End Sub

Private Sub Form_BeforeDelConfirm(Cancel As Integer, Response As Integer)
  MsgBox "Form_BeforeDelConfirm"
End Sub

Private Sub Form_Current()
'  MsgBox "Form_Current"
End Sub

Private Sub Form_Delete(Cancel As Integer)
  MsgBox "Form_Delete"
'  Call Me.Parent.Req
End Sub

Private Sub Form_Load()
  Set frm = New clsFrmKai2
End Sub

'Private Sub Form_Close()
'  Set frm = Nothing
'End Sub

 

 
6)フォーム「F_ALL」

前述してきた 親(メイン)からのサブフォーム参照 / 子(サブ)からの親フォーム参照
これ、全ての確認パターンで共通になっているので、サブフォームをコロコロと切り換える・・・
この切り替えをオプショングループ「op1」を使って操作できるように・・・・
以下の黄色い部分が追加した記述になります。
Private Sub op1_Click()
  Dim sS As String
  Dim ctl As Control

  sS = "F_T" & Me.op1
  For Each ctl In Me.Controls
    If (ctl.ControlType = acLabel) Then
      If (ctl.Parent Is Me.FSUB) Then
        ctl.Caption = sS
        Exit For
      End If
    End If
  Next
  Me.FSUB.SourceObject = sS
End Sub

Private Sub Form_Load()
  Me.op1 = 0
  Call op1_Click
End Sub


Private Sub btn1_Click()
  If (IsNull(Me.txt0)) Then Exit Sub
  With Me.FSUB.Form.RecordsetClone
    If (Me.txt0 > .RecordCount) Then Exit Sub
    .AbsolutePosition = Me.txt0 - 1
    CurrentProject.Connection.Execute "DELETE * FROM T1 WHERE an = " & .Fields("an")
    Call Req
  End With
End Sub

Public Sub Req()
'  Me.FSUB.Form.Requery
  Me.FSUB.Requery
End Sub

 
サブフォームコントロール「FSUB」にくっ付いているラベルの表示を変えながら、
ソースオブジェクトを切り替えます。

※ テキストボックスにくっ付いているラベル表示変更は
 Me.テキストボックス名.Controls(0).Caption で設定先がわかりますが、
 サブフォームコントロールでは上記の様な辿り方はできないようです。
 Controls(0) としてしまうと、サブフォーム内のコントロールが求まってしまうので・・・・


※※ 削除操作で Form_BeforeDelConfirm / Form_AfterDelConfirm が呼ばれない
 これ、上記以外に推測/想定できますでしょうか・・・・

※※※ こういう想定が出来る・・・云々、教えてください。


サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt123_2000.zipkEnt123_2003.zipkEnt123_2007.zip
 サイズ 59,41162,32466,311
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2012/03/31

Category: やってみる

TB: 0  /  CM: 0

top △

この記事に対するコメント

top △

コメントの投稿

Secret

top △

トラックバック

トラックバックURL
→http://kikutips.blog13.fc2.com/tb.php/123-00f0185b
この記事にトラックバックする(FC2ブログユーザー)

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。