SSブログ
帰ってきた ｜株価暴落 ブログトップ

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

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

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

・履歴を残すためのテーブル名：T_PWMngID
・履歴の数：10個（maxRcdNum1 = 10）
・すでに履歴に退避済のIDだったら、そのIDを履歴から一旦消して、追加し直す。
・履歴を更新するときは、一番古い履歴を１つ消して、最新の履歴を追加する。
・履歴を更新したら、コンボボックスに反映して、選択できるようにする。
・コンボボックスの履歴を選択して、その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
タグ：履歴 VBA アクセス
2018-10-05 06:40  ヤバイぜ！(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 コメント

帰ってきた ｜株価暴落 ブログトップ

リンク集

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