So-net無料ブログ作成

アクセス小僧:履歴を残す(5) [コンピューター]

アクセス小僧:履歴を残す(2)
https://cheese999.blog.so-net.ne.jp/2018-10-05

で紹介した、【選択した履歴のレコードへ飛ぶためのマクロ】ですが、フィルタが、かかったままで実行すると、エラーになってしまうことが分かりました。

filter_on.jpg

そこで、フィルタ解除のコードを追加しました。

【手順】
1. 履歴のコンボボックス(PW_Mng_ID履歴)が選択されてなかったら、マクロ終了
2. コンボボックスの何番目(ListIndex)が選択されているかを元に、履歴テーブル(T_PWMngID)を検索し、選択されたレコードのID(PW_Mng_IDt)を調べる
3. 選択されたレコードのID(PW_Mng_IDt)を元に、テーブル(T_パスワード管理)を検索し、レコード番号(AbsPos1, 先頭レコードは0)を得る
4. フィルタ解除 <= 今回追加
5. レコード番号(AbsPos1)を元に、フォーム(パスワード入力)上で、そのレコードに移動

【選択した履歴のレコードへ飛ぶためのマクロ】

Private Sub PW_Mng_ID履歴Go_Click()
  '【変数】
  Dim Ans1 As Long ' 答え
  Dim PW_Mng_IDt As Long ' 履歴上のID
  Dim AbsPos1 As Long 'レコード番号
  Dim Str1 As String ' 文字列
  '【実行コード】
  If [PW_Mng_ID履歴].ListIndex = -1 Then
    Ans1 = MsgBox("PW_Mng_ID履歴が選択されていません。", vbCritical, "エラー")
    Exit Sub
  End If
  Str1 = "T_PM_ID = " & CStr([PW_Mng_ID履歴].ListIndex + 1)
  PW_Mng_IDt = DLookup("PW_Mng_ID1", "T_PWMngID", Str1)
  Debug.Print "[PW_Mng_ID履歴].ListIndex=" & [PW_Mng_ID履歴].ListIndex & " PW_Mng_IDt=" & PW_Mng_IDt
  AbsPos1 = IDtoAbsPos1("T_パスワード管理", "PW_Mng_ID", PW_Mng_IDt)
  Me.AllowAdditions = True '追加の許可
  Me.FilterOn = False ' フィルタ解除
  If AbsPos1 <> -1 Then
    [チェック_ID履歴] = True
    DoCmd.GoToRecord acDataForm, "パスワード入力", acGoTo, AbsPos1 + 1
    [チェック_ID履歴] = False
  End If
  ' With Me.Recordset
  ' .FindFirst "PW_Mng_ID = " & PW_Mng_IDt
  ' End With
End Sub

【指定されたIDをテーブルで検索、見つかったらレコード番号を返すマクロ】

Function IDtoAbsPos1(NmTable1 As String, NmField1 As String, ID1 As Long) As Long
  '【機能】指定されたIDをテーブルで検索、見つかったらレコード番号を返す
  '【引数】
  ' NmTable1 : テーブル名
  ' NmField1 : フィールド名
  ' ID1 : 主キー
  '【返り値】
  ' レコード番号(返すレコード番号が無いときは、-1)
  '【変数】
  Dim db1 As DAO.Database ' データベース
  Dim rs1 As DAO.Recordset ' レコードセット
  Dim AbsPos1 As Long 'レコード番号
  Dim Ans1 As Long ' 答え
  '【実行コード】
  ' テーブルをレコードセットとして開く
  Set db1 = CurrentDb()
  Set rs1 = db1.OpenRecordset(NmTable1, dbOpenDynaset)
  rs1.MoveFirst ' 先頭レコードへ
  rs1.MoveLast ' 最終レコードへ
  rs1.MoveFirst ' 先頭レコードへ
  rs1.FindFirst NmField1 & " = " & ID1
  If rs1.NoMatch Then
    Ans1 = MsgBox(NmField1 & " = " & ID1 & "がありません。", vbCritical, "エラー")
    Set rs1 = Nothing
    Set db1 = Nothing
    IDtoAbsPos1 = -1
    Exit Function
  End If
  AbsPos1 = rs1.AbsolutePosition
  Set rs1 = Nothing
  Set db1 = Nothing
  IDtoAbsPos1 = AbsPos1
End Function
ヤバイぜ!(8)  コメント(1) 
共通テーマ:パソコン・インターネット

ヤバイぜ! 8

コメント 1

cheese999

ヤバイぜ! ありがとうございます(^_0)ノ
by cheese999 (2018-12-09 08:24) 

コメントを書く

お名前:[必須]
URL:
コメント:
画像認証:
下の画像に表示されている文字(英大文字の「オー」、英小文字の「ユー」、アラビア数字の「ハチ」、アラビア数字の「イチ」、アラビア数字の「ニ」)を入力してください。

Facebook コメント