SSブログ

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

フォームにて、参照したレコードのID(主キー)の履歴を

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

・履歴を残すためのテーブル名:T_PWMngID
・履歴の数:10個(maxRcdNum1 = 10)
・すでに履歴に退避済のIDだったら、そのIDを履歴から一旦消して、追加し直す。
・履歴を更新するときは、一番古い履歴を1つ消して、最新の履歴を追加する。
・履歴を更新したら、コンボボックスに反映して、選択できるようにする。
・コンボボックスの履歴を選択して、そのIDのレコードへ飛ぶときは、別マクロを起動して、飛ぶ。
・履歴をたどって、レコードを見ているときは、履歴を変更しない。([チェック_ID履歴] = True)
・履歴の残すマクロ「USSaveID1」は、レコード移動時「Form_Current」イベントが発生したとき、呼ばれる。

【履歴の残すマクロ】

Private Sub USSaveID1()
  '【機能】PW_Mng_ID, FieldName1, 検索を退避
  '【変数】
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim i, j, k 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リスト
  '【実行コード】
  If [チェック_ID履歴] Then
    Exit Sub
  End If
  Debug.Print "DCount(""*"", ""T_PWMngID"")=" & DCount("*", "T_PWMngID")
  maxRcdNum1 = DCount("*", "T_PWMngID") ' T_PWMngIDテーブルの最大レコード数 ' T_PWMngIDテーブルの最大レコード数
  Set db = CurrentDb()
  ' テーブルを開く
  Set rs = db.OpenRecordset("T_PWMngID", dbOpenDynaset)
  rs.MoveFirst ' 先頭レコードへ
  rs.MoveLast ' 最終レコードへ
  rs.MoveFirst ' 先頭レコードへ
  ' コンボボックスを更新
  PW_Mng_ID_List = ""
  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
  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でなければ、T_PM_ID=maxRcdNum1(10)-1, - 1を1つ後ろにずらして、T_PM_ID=1に退避
  ' 退避済のIDなら、T_PM_ID=rs.AbsolutePosition, - 1を1つ後ろにずらして、T_PM_ID=1に退避
  If rs.NoMatch Then
    k = maxRcdNum1
  Else
    k = rs.AbsolutePosition + 1
  End If
  For i = k 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
  rs.Close
  Set rs = Nothing ' 解放
  db.Close
  Set db = Nothing ' 解放
  [PW_Mng_ID履歴].SetFocus
  [PW_Mng_ID履歴].ListIndex = 0
  [再クエリ].SetFocus
End Sub

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

Private Sub PW_Mng_ID履歴Go_Click()
  ' Debug.Print [PW_Mng_ID履歴]
  [チェック_ID履歴] = True
  With Me.Recordset
    .FindFirst "PW_Mng_ID = " & [PW_Mng_ID履歴]
  End With
  [チェック_ID履歴] = False
End Sub

【履歴を前にたどるマクロ】

Private Sub ID履歴前へ_Click()
  '【変数】
  Dim i As Long ' 整数
  Dim Ans As Integer ' 答え
  Dim maxRcdNum1 As Long ' T_PWMngIDテーブルの最大レコード数
  '【実行コード】
  ' Debug.Print "ListCount=" & [PW_Mng_ID履歴].ListCount
  ' Debug.Print "ListIndex=" & [PW_Mng_ID履歴].ListIndex
  ' Debug.Print "Value=" & [PW_Mng_ID履歴].Value
  ' Debug.Print "IsNull=" & IsNull([PW_Mng_ID履歴].Value)
  maxRcdNum1 = DCount("*", "T_PWMngID") ' T_PWMngIDテーブルの最大レコード数
  [チェック_ID履歴] = True
  Select Case [PW_Mng_ID履歴].ListIndex
  Case -1 To (maxRcdNum1 - 2)
    [PW_Mng_ID履歴].SetFocus
    [PW_Mng_ID履歴].ListIndex = [PW_Mng_ID履歴].ListIndex + 1
    If IsNull([PW_Mng_ID履歴].Value) Then
      [チェック_ID履歴] = False
      Exit Sub
    End If
    With Me.Recordset
      .FindFirst "PW_Mng_ID = " & [PW_Mng_ID履歴].Value
      ' Debug.Print ".NoMatch=" & .NoMatch
      If .NoMatch Then
        Ans = MsgBox("PW_Mng_ID = " & [PW_Mng_ID履歴].Value & "が見つかりません。", vbCritical, "エラー")
      End If
    End With
  End Select
  [チェック_ID履歴] = False
End Sub

【履歴を後にたどるマクロ】

Private Sub ID履歴後へ_Click()
'【変数】
  Dim i As Long ' 整数
  Dim Ans As Integer ' 答え
  Dim maxRcdNum1 As Long ' T_PWMngIDテーブルの最大レコード数
  '【実行コード】
  ' Debug.Print "ListCount=" & [PW_Mng_ID履歴].ListCount
  ' Debug.Print "ListIndex=" & [PW_Mng_ID履歴].ListIndex
  ' Debug.Print "Value=" & [PW_Mng_ID履歴].Value
  ' Debug.Print "IsNull=" & IsNull([PW_Mng_ID履歴].Value)
  maxRcdNum1 = DCount("*", "T_PWMngID") ' T_PWMngIDテーブルの最大レコード数
  [チェック_ID履歴] = True
  Select Case [PW_Mng_ID履歴].ListIndex
  Case 1 To (maxRcdNum1 - 1)
    [PW_Mng_ID履歴].SetFocus
    [PW_Mng_ID履歴].ListIndex = [PW_Mng_ID履歴].ListIndex - 1
    If IsNull([PW_Mng_ID履歴].Value) Then
      [チェック_ID履歴] = False
      Exit Sub
    End If
    With Me.Recordset
      .FindFirst "PW_Mng_ID = " & [PW_Mng_ID履歴].Value
      ' Debug.Print ".NoMatch=" & .NoMatch
      If .NoMatch Then
        Ans = MsgBox("PW_Mng_ID = " & [PW_Mng_ID履歴].Value & "が見つかりません。", vbCritical, "エラー")
      End If
    End With
  Case -1
    [PW_Mng_ID履歴].SetFocus
    [PW_Mng_ID履歴].ListIndex = (maxRcdNum1 - 1)
    If IsNull([PW_Mng_ID履歴].Value) Then
      [チェック_ID履歴] = False
      Exit Sub
    End If
    With Me.Recordset
      .FindFirst "PW_Mng_ID = " & [PW_Mng_ID履歴].Value
      ' Debug.Print ".NoMatch=" & .NoMatch
      If .NoMatch Then
        Ans = MsgBox("PW_Mng_ID = " & [PW_Mng_ID履歴].Value & "が見つかりません。", vbCritical, "エラー")
      End If
    End With
  End Select
  [チェック_ID履歴] = False
End Sub
ヤバイぜ!(16)  コメント(4) 
共通テーマ:日記・雑感

ヤバイぜ! 16

コメント 4

cheese999

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

tarou

お早うございます、大坂城天守閣に
コメントを有難うございました。
天気が良かったので、眺めは最高でした(^_^)v

by tarou (2018-10-07 04:04) 

cheese999

tarouさん、
徳川の大砲玉が飛んできたら、たまったもんじゃ、ありませんネ(^_0)ノ
by cheese999 (2018-10-07 06:13) 

cheese999

T_PWMngIDテーブルの最大レコード数を変更しても、マクロを変更しなくてすむように、マクロを変更しました。
by cheese999 (2018-10-07 06:16) 

コメントを書く

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

Facebook コメント