SSブログ

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

参照したレコード履歴を

別テーブルに残して、コンボボックスに反映し、戻りたいときに、すぐ戻れるようにするための
マクロを作ってみました。

・履歴を残すためのテーブル名:T_PWMngID
・履歴の数:10個(maxRcdNum1 = 10)
・すでに履歴に退避済のIDだったら、履歴を更新しない。
・履歴を更新するときは、一番古い履歴を1つ消して、最新の履歴を追加する。
・履歴を更新したら、コンボボックスに反映して、選択できるようにする。
・コンボボックスの履歴を選択して、そのIDのレコードへ飛ぶときは、別マクロを起動して、飛ぶ。

Private Sub USSaveID1()
  '【機能】PW_Mng_ID, FieldName1, 検索を退避
  '【変数】
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim i, j As Long ' 整数
  Dim Ans As Long ' 答え
  Dim maxRcdNum1 As Long ' T_PWMngIDテーブルの最大レコード数
  Dim tmpPW_Mng_ID1, tmpFieldName1, tmpSearch_Txt ' 1個前のレコード内容
  Dim PW_Mng_ID_List As String ' PW_Mng_IDリスト
  '【実行コード】
  maxRcdNum1 = 10 ' T_PWMngIDテーブルの最大レコード数
  Set db = CurrentDb()
  ' テーブルを開く
  Set rs = db.OpenRecordset("T_PWMngID", dbOpenDynaset)
  rs.MoveFirst ' 先頭レコードへ
  rs.MoveLast ' 最終レコードへ
  rs.MoveFirst ' 先頭レコードへ
  Debug.Print "PW_Mng_ID=" & [PW_Mng_ID]
  rs.FindFirst "PW_Mng_ID1=" & [PW_Mng_ID] ' 退避済のIDか探索
  Debug.Print "rs.AbsolutePosition=" & rs.AbsolutePosition
  Debug.Print "rs.NoMatch=" & rs.NoMatch
  ' 退避済のIDでなければ、退避
  If rs.NoMatch Then
    For i = maxRcdNum1 To 1 Step -1
      rs.MoveFirst ' 先頭レコードへ
      rs.FindFirst "T_PM_ID=" & i
      If rs.NoMatch Then
        Ans = MsgBox("T_PM_ID=" & i & "が見つかりません。[USSaveID1]", vbCritical, "エラー")
        Exit For
      Else
        If i = 1 Then
          rs.Edit ' 編集用のバッファを用意
          rs![PW_Mng_ID1] = [PW_Mng_ID] ' PW_Mng_IDを退避
          rs![FieldName1] = [FieldName1].ListIndex ' FieldName1のLinsIndexを退避
          rs![Search_Txt] = [検索].Value ' 検索テキストを退避
          rs.Update ' 変更内容を保存
        Else
          rs.MoveFirst ' 先頭レコードへ
          j = i - 1
          rs.FindFirst "T_PM_ID=" & j
          If rs.NoMatch Then
            Ans = MsgBox("T_PM_ID=" & j & "が見つかりません。[USSaveID1]", vbCritical, "エラー")
            Exit For
          End If
          ' 1個前のレコードを退避
          tmpPW_Mng_ID1 = rs![PW_Mng_ID1]
          tmpFieldName1 = rs![FieldName1]
          tmpSearch_Txt = rs![Search_Txt]
          ' 次のレコードへ
          rs.FindFirst "T_PM_ID=" & i
          ' 次のレコードへコピー
          rs.Edit ' 編集用のバッファを用意
          rs![PW_Mng_ID1] = tmpPW_Mng_ID1
          rs![FieldName1] = tmpFieldName1
          rs![Search_Txt] = tmpSearch_Txt
          rs.Update ' 変更内容を保存
        End If
      End If
    Next i
    ' コンボボックスを更新
    PW_Mng_ID_List = ""
    rs.MoveFirst ' 先頭レコードへ
    For i = 1 To maxRcdNum1 Step 1
      Debug.Print "i=" & i & " PW_Mng_ID1=" & rs![PW_Mng_ID1]
      PW_Mng_ID_List = PW_Mng_ID_List & rs![PW_Mng_ID1]
      If i <> maxRcdNum1 Then
        PW_Mng_ID_List = PW_Mng_ID_List & ";"
        rs.MoveNext ' 次のレコードへ
      End If
    Next i
     '値集合タイプ
    Forms!パスワード入力!PW_Mng_ID履歴.RowSourceType = "Value List"
    '値集合ソース
    Forms!パスワード入力!PW_Mng_ID履歴.RowSource = PW_Mng_ID_List
  End If
  rs.Close
  Set rs = Nothing ' 解放
  db.Close
  Set db = Nothing ' 解放
End Sub

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

Private Sub PW_Mng_ID履歴Go_Click()
  ' Debug.Print [PW_Mng_ID履歴]
  With Me.Recordset
    .FindFirst "PW_Mng_ID = " & [PW_Mng_ID履歴]
  End With
End Sub
ヤバイぜ!(18)  コメント(1) 
共通テーマ:パソコン・インターネット

ヤバイぜ! 18

コメント 1

cheese999

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

コメントを書く

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

Facebook コメント

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。