FC2ブログ

スポンサーサイト 


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

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

フィルタの適用/解除とその場所 


ある質問に回答して、一応動いた報告がありクローズしたのですが・・・・

レコードを指定して特定のフォームを開くというボタンまでは作れた。
起動されたフォームにはフィルタがかかっており、他のレコードに移動できない。
項目を入力して一旦閉じ、再度指定せずに開くと入力した内容は反映されている。
他のレコードと見比べる時に一回一回閉じないと確認できないので困っている。
閉じずに他のレコードと見比べるには・・・・
また、見比べる時に、表示はその場所から動かない方が・・・・

動いた・・・で、クローズされた回答内容は以下。(私の回答ですけど・・・)
' コマンドボタン「btn1」をヘッダ部等に配置して、以下を記述

Private Sub btn1_Click()
  If (Me.FilterOn) Then
    Me.Painting = False
    Me.FilterOn = False
    With Me.RecordsetClone
      .FindFirst Me.Filter
      If (Not .NoMatch) Then Me.Bookmark = .Bookmark
    End With
    Me.Painting = True
  Else
    Me.FilterOn = True
  End If
End Sub

追記 6/10
この方法ができるのは、即値に展開(例えば、 "ID = 4" )した場合です。
"ID = [Forms]![フォーム名]![コントロール名]" では .FindFirst 時にエラーになります。

kEnt134_1  kEnt134_2
これで一応、大半のものには対応できると思いますが、
いろいろな場合場合を検証するとエラーが出てくるようになります。

どこまでを回答すれば良いのか・・・・難しいですね。
(回答するにあたり、エラー処理は省いちゃいますしね)

まず、エラーの発生する可能性、第一位は、上記黄色い部分で発生するもの・・・・
これ、レコード編集中に処理が走ったとした場合、黄色部分で Form_BeforeUpdate が呼ばれます。
素直にレコードが保存されれば問題はありませんが Cancel = True を設定したとか・・・・
最終的に Me.Bookmark = .Bookmark 部分でエラーになります。
(直前の操作はキャンセルされました の 2001 エラー)
なので、事前にレコードを確定させる処理を行っておく必要があります。
または、編集中なら処理しないとか・・・・

第二位は、過去記事にも取り上げていましたが、私が確認していなかったもの・・・・
それは、Me.Filter = "" かつ Me.FilterOn = False 時に Me.FilterOn = True を代入したら・・・
Access 2007 では、Me.FilterOn = True になることはありませんでした。
2000 / 2003 では、Me.FilterOn = True に設定されてしまいます。( Me.Filter = "" なのに)
仕様がどちらなのかわかりませんが、2007 の動きの方が私にはシックリきます。
この辺の動きが違っているとは思っていなかったし、確認していたつもりが、していなかった・・・

これ、Me.Filter = "" なのに、Me.FilterOn = True になってしまうと、次クリックすると
.FindFirst Me.Filter 部分で、演算子がないエラー 3077 になってしまいます。

過去記事修正しなくては・・・・面倒くさいな・・・・・そのうちに・・・・
VBA の記述と、コメントの関係もこんな感じですかね・・・
記述するコメントは最小限にとどめたいですね・・・
 
まず、動作確認するテーブル「T1」を以下の様に作ります。
anID名前備考
11A 
22B 
33C 
44A 
55B 
66C 
「an」はオートナンバ、「ID」は長整数、「名前」「備考」はテキスト

用意したフォームは、以下の4つとメニュー
「F11」:回答したそのもの DoCmd.OpenForm で WhereCondition 指定(フィルタ:絞込み)
「F1」:上記「F11」改善版
「F2」:検索版 DoCmd.OpenForm で検索条件を OpenArgs で指定
「F3」:検索/フィルタ複合版 「F2」の改造版


メニューフォーム「F_MENU」

kEnt134_M
フォームは上の様な感じです。
何について絞り込む/検索する(「ID」と「名前」だけですが)か入力し、
起動するフォームボタンをクリックします。

記述したのは以下
Private Const sAndOr As String = " AND "

Private Function MakeWhere() As String
  Dim sWhere As String

  sWhere = ""
  If (Not IsNull(Me.txt1)) Then
    sWhere = sWhere & sAndOr & Me.txt1.Controls(0).Caption & " = " & Me.txt1
  End If
  If (Not IsNull(Me.cbx1)) Then
    sWhere = sWhere & sAndOr & Me.cbx1.Controls(0).Caption & " = '" & Me.cbx1 & "'"
  End If
  If (Len(sWhere) > 0) Then sWhere = Mid(sWhere, Len(sAndOr) + 1)
  MakeWhere = sWhere
End Function

Private Sub btn1_Click()
  DoCmd.OpenForm "F1", , , MakeWhere
End Sub

Private Sub btn11_Click()
  DoCmd.OpenForm "F11", , , MakeWhere
End Sub

Private Sub btn2_Click()
  Dim sWhere As String

  sWhere = MakeWhere
  If (Len(sWhere) > 0) Then
    DoCmd.OpenForm "F2", , , , , , sWhere
  Else
    DoCmd.OpenForm "F2"
  End If
End Sub

Private Sub btn3_Click()
  Dim sWhere As String

  sWhere = MakeWhere
  If (Len(sWhere) > 0) Then
    DoCmd.OpenForm "F3", , , , , , sWhere
  Else
    DoCmd.OpenForm "F3"
  End If
End Sub

 

回答した内容のフォーム「F11」

kEnt134_1  kEnt134_2
テーブル「T1」を元に、フォームウィザードで「an」抜きで表形式として作成します。
ヘッダ部分に、FilterOn / Filter の状態を表示するラベル「lab1」を配置
また、フィルタ動作を切り替えるコマンドボタン「btn1」を配置
「ポップアップ」を「はい」、「作業ウィンドウ固定」を「はい」の表示にします。

VBAで以下を記述します。
Private Sub Form_Open(Cancel As Integer)
  Me.InsideHeight = Me.Section(acHeader).Height _
          + Me.Section(acDetail).Height * 10
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
  If (MsgBox("Update Cancel ?", vbYesNo + vbQuestion) = vbYes) Then
    Cancel = True
  End If
End Sub

Private Sub btn1_Click()
  If (Me.FilterOn) Then
    Me.Painting = False
    Me.FilterOn = False
    With Me.RecordsetClone
      .FindFirst Me.Filter
      If (Not .NoMatch) Then Me.Bookmark = .Bookmark
    End With
    Me.Painting = True
  Else
    Me.FilterOn = True
  End If
End Sub

Private Sub lab1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Me.lab1.Caption = "Me.FilterOn = " & IIf(Me.FilterOn, "True", "False") & vbCrLf _
          & "Me.Filter = """ & Me.Filter & """"
End Sub

2007 の帳票フォームをポップアップにするだけでは、意味なく縦長になってしまうので、
Me.InsideHeight を10件表示の大きさに設定するようにしました。
また、ラベル「lab1」上をマウスが通ったら、現在の FilterOn / Filter を表示するように。
問題第一位にあげた編集中の動きをみるために、Form_BeforeUpdate で Cancel を設定できるように


回答改善版フォーム「F1」

フォーム「F11」を「F1」としてコピーします。
フォーム「F11」から変更(改善)した部分は、以下黄色部分
Private Sub Form_Open(Cancel As Integer)
  Me.InsideHeight = Me.Section(acHeader).Height _
          + Me.Section(acDetail).Height * 10
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
  If (MsgBox("Update Cancel ?", vbYesNo + vbQuestion) = vbYes) Then
    Cancel = True
  End If
End Sub

Private Sub btn1_Click()
  On Error Resume Next
  If (Me.Dirty) Then Me.Dirty = False
  If (Me.Dirty) Then
    MsgBox "チャンと登録して !!", vbCritical
    Exit Sub
  End If

  On Error GoTo 0

  If (Me.FilterOn) Then
    Me.Painting = False
    Me.FilterOn = False
    With Me.RecordsetClone
      .FindFirst Me.Filter
      If (Not .NoMatch) Then Me.Bookmark = .Bookmark
    End With
    Me.Painting = True
  ElseIf (Len(Me.Filter) > 0) Then
    Me.FilterOn = True
  End If
End Sub

Private Sub lab1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Me.lab1.Caption = "Me.FilterOn = " & IIf(Me.FilterOn, "True", "False") & vbCrLf _
          & "Me.Filter = """ & Me.Filter & """"
End Sub

 
編集中レコードを保存する時、DoCmd.RunCommand acCmdSaveRecord を使いますが、
Me.Dirty = False でも同じことが出来るみたいです。
フォームをアクティブにする必要が無い分、Me.Dirty = False の方が最近お気に入りです。

Me.Dirty = False 代入時に、Form_BeforeUpdate が呼ばれますが、
Cancel = True とかならエラーになるので、エラー無視して、まだ Me.Dirty = True だったら
レコードが保存されていない・・・・っていう判別でも良いのかも・・・・

また、Me.Filter が設定されていなければ、Me.FilterOn = True にしない様に
(Access 2000 / 2003 用に・・・)
追記 6/10 Me.FilterOn = Len(Me.Filter) > 0
って書き方もあるけど、見た目やってることがわかりやすい方で・・・


単に検索するフォーム「F2」

フォーム「F1」を「F2」名でコピーします。

ここでは、絞り込みではなく、あったらそこを表示するように(検索)、
検索用の文字列を OpenArgs 経由で伝えるように・・・・
起動された方は、OpenArgs が設定されていれば検索する・・・・
Me.Filter が設定されていないので、「btn1」をクリックしても何も起きません。
追記 6/10 Dirty の処理があるので、そうでもない

フォーム「F1」から変更した部分は、以下黄色部分
Private Sub Form_Open(Cancel As Integer)
  Me.InsideHeight = Me.Section(acHeader).Height _
          + Me.Section(acDetail).Height * 10
  If (Not IsNull(Me.OpenArgs)) Then
    With Me.RecordsetClone
      .FindFirst Me.OpenArgs
      If (Not .NoMatch) Then Me.Bookmark = .Bookmark
    End With
  End If

End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
  If (MsgBox("Update Cancel ?", vbYesNo + vbQuestion) = vbYes) Then
    Cancel = True
  End If
End Sub

Private Sub btn1_Click()
  On Error Resume Next
  If (Me.Dirty) Then Me.Dirty = False
  If (Me.Dirty) Then
    MsgBox "チャンと登録して !!", vbCritical
    Exit Sub
  End If

  On Error GoTo 0
  If (Me.FilterOn) Then
    Me.Painting = False
    Me.FilterOn = False
    With Me.RecordsetClone
      .FindFirst Me.Filter
      If (Not .NoMatch) Then Me.Bookmark = .Bookmark
    End With
    Me.Painting = True
  ElseIf (Len(Me.Filter) > 0) Then
    Me.FilterOn = True
  End If
End Sub

Private Sub lab1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Me.lab1.Caption = "Me.FilterOn = " & IIf(Me.FilterOn, "True", "False") & vbCrLf _
          & "Me.Filter = """ & Me.Filter & """"
End Sub

 

検索/フィルタ複合フォーム「F3」

フォーム「F2」を「F3」名でコピーします。
検索して該当するものがあったら、Me.Filter に OpenArgs を設定しておきます。
以降の操作で Me.FilterOn を変更して、絞り込み表示できるようにしておきます。
フォーム「F2」から変更した部分は、以下黄色部分
Private Sub Form_Open(Cancel As Integer)
  Me.InsideHeight = Me.Section(acHeader).Height _
          + Me.Section(acDetail).Height * 10
  If (Not IsNull(Me.OpenArgs)) Then
    With Me.RecordsetClone
      .FindFirst Me.OpenArgs
      If (Not .NoMatch) Then
        Me.Bookmark = .Bookmark
        Me.Filter = Me.OpenArgs
      End If

    End With
  End If
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
  If (MsgBox("Update Cancel ?", vbYesNo + vbQuestion) = vbYes) Then
    Cancel = True
  End If
End Sub

Private Sub btn1_Click()
  On Error Resume Next
  If (Me.Dirty) Then Me.Dirty = False
  If (Me.Dirty) Then
    MsgBox "チャンと登録して !!", vbCritical
    Exit Sub
  End If

  On Error GoTo 0
  If (Me.FilterOn) Then
    Me.Painting = False
    Me.FilterOn = False
    With Me.RecordsetClone
      .FindFirst Me.Filter
      If (Not .NoMatch) Then Me.Bookmark = .Bookmark
    End With
    Me.Painting = True
  ElseIf (Len(Me.Filter) > 0) Then
    Me.FilterOn = True
  End If
End Sub

Private Sub lab1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Me.lab1.Caption = "Me.FilterOn = " & IIf(Me.FilterOn, "True", "False") & vbCrLf _
          & "Me.Filter = """ & Me.Filter & """"
End Sub

 

知ってる範囲なら具体的に書いてあげたいけど、回答するって、難しいですね。
でも、そもそも知っている範囲自体が間違ってたら・・・・
漠然とした内容になっていくのかなぁ・・・・

でも、鵜呑みにはしないよね・・・・
少なくても採用するにはそれなりの検証はするよね・・・・
なら、少しでも具体的なものを書いた方が良いのかなぁ・・・・

でも、

でも、でも


サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt134_2000.zipkEnt134_2003.zipkEnt134_2007.zip
 サイズ 32,07133,01735,655
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2012/06/09

Category: 訂正あり

TB: --  /  CM: 0

top △

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

top △

コメントの投稿

Secret

top △


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