アクセス小僧：履歴を残す(3) [コンピューター]
アクセス小僧：履歴を残す(2)
https://cheese999.blog.so-net.ne.jp/2018-10-05
で、フォーム上に展開したテーブル（テーブルA）のうち、フォーム上で参照したレコードのID（主キー）の履歴を別テーブル（テーブルB）に残して、後で戻るためのマクロを紹介しました。
しかし、後で戻るためのマクロの下記コード部分が、うまく動かない場合があることが分かりました。
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
フォーム上に展開したテーブル（テーブルA）のレコードをMe.Recordsetとして、その中でID（主キー）検索をかけるのは正しい方法では無いのかもしれません。
別のやり方として、テーブル（テーブルA）を別のRecordsetとして開き、その中でID検索を行ってレコード番号を入手、フォーム上でレコード番号を元に移動するマクロに変更しました。
加えて、履歴のコンボボックスの値（[PW_Mng_ID履歴].Value）ではなく、履歴のコンボボックスのListIndex（[PW_Mng_ID履歴].ListIndex）を参照することで、コンボボックスに表示する値をID番号だけではなく、項目名とか、氏名とか、人間が見て分かりやすい内容にすることができます。
【選択した履歴のレコードへ飛ぶためのマクロ（新）】
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 ' 文字列
'【実行コード】
' ID履歴のコンボボックス（テーブルBを展開したもの）の選択肢が選択されていなければ終了
If [PW_Mng_ID履歴].ListIndex = -1 Then
Ans1 = MsgBox("PW_Mng_ID履歴が選択されていません。", vbCritical, "エラー")
Exit Sub
End If
' テーブルBの主キー「T_PM_ID」は、1, 2 - なので、コンボボックスのListIndexに1を足す
Str1 = "T_PM_ID = " & CStr([PW_Mng_ID履歴].ListIndex + 1)
' テーブルBを検索して、テーブルAの主キーを得る
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
' テーブルAをレコードセットとして開き、ID検索、レコード番号(AbsolutePosition)を得る
AbsPos1 = IDtoAbsPos1("T_パスワード管理", "PW_Mng_ID", PW_Mng_IDt)
' レコードが見つかったら、フォーム上で、そのレコードに移動する
If AbsPos1 <> -1 Then
[チェック_ID履歴] = True
DoCmd.GoToRecord acDataForm, "パスワード入力", acGoTo, AbsPos1 + 1
[チェック_ID履歴] = False
End If
End Sub
【テーブルAをレコードセットとして開き、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
【選択した履歴のレコードへ飛ぶためのマクロ（旧）】
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
この変更を行った後、新規レコードをフォームから追加しようとしたところ、次のエラーが発生しました。
ネットで調べたけど、原因不明。。。![[猫]](https://blog.ss-blog.jp/_images_e/101.gif)
https://cheese999.blog.so-net.ne.jp/2018-10-05
で、フォーム上に展開したテーブル（テーブルA）のうち、フォーム上で参照したレコードのID（主キー）の履歴を別テーブル（テーブルB）に残して、後で戻るためのマクロを紹介しました。
しかし、後で戻るためのマクロの下記コード部分が、うまく動かない場合があることが分かりました。
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
フォーム上に展開したテーブル（テーブルA）のレコードをMe.Recordsetとして、その中でID（主キー）検索をかけるのは正しい方法では無いのかもしれません。
別のやり方として、テーブル（テーブルA）を別のRecordsetとして開き、その中でID検索を行ってレコード番号を入手、フォーム上でレコード番号を元に移動するマクロに変更しました。
加えて、履歴のコンボボックスの値（[PW_Mng_ID履歴].Value）ではなく、履歴のコンボボックスのListIndex（[PW_Mng_ID履歴].ListIndex）を参照することで、コンボボックスに表示する値をID番号だけではなく、項目名とか、氏名とか、人間が見て分かりやすい内容にすることができます。
【選択した履歴のレコードへ飛ぶためのマクロ（新）】
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 ' 文字列
'【実行コード】
' ID履歴のコンボボックス（テーブルBを展開したもの）の選択肢が選択されていなければ終了
If [PW_Mng_ID履歴].ListIndex = -1 Then
Ans1 = MsgBox("PW_Mng_ID履歴が選択されていません。", vbCritical, "エラー")
Exit Sub
End If
' テーブルBの主キー「T_PM_ID」は、1, 2 - なので、コンボボックスのListIndexに1を足す
Str1 = "T_PM_ID = " & CStr([PW_Mng_ID履歴].ListIndex + 1)
' テーブルBを検索して、テーブルAの主キーを得る
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
' テーブルAをレコードセットとして開き、ID検索、レコード番号(AbsolutePosition)を得る
AbsPos1 = IDtoAbsPos1("T_パスワード管理", "PW_Mng_ID", PW_Mng_IDt)
' レコードが見つかったら、フォーム上で、そのレコードに移動する
If AbsPos1 <> -1 Then
[チェック_ID履歴] = True
DoCmd.GoToRecord acDataForm, "パスワード入力", acGoTo, AbsPos1 + 1
[チェック_ID履歴] = False
End If
End Sub
【テーブルAをレコードセットとして開き、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
【選択した履歴のレコードへ飛ぶためのマクロ（旧）】
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
この変更を行った後、新規レコードをフォームから追加しようとしたところ、次のエラーが発生しました。
ネットで調べたけど、原因不明。。。
ヤバイぜ！ ありがとうございます(^_0)ノ
by cheese999 (2018-11-02 06:54)
コンボボックスの値ではなく、ListIndexを参照するやり方に変更した説明を追記しました。
by cheese999 (2018-11-05 08:06)