アクセス小僧:履歴を残す(4) [コンピューター]
アクセス小僧:履歴を残す(2)
https://cheese999.blog.so-net.ne.jp/2018-10-05
で紹介した、フォームで開いているテーブルAの閲覧履歴を別テーブルBに残して、フォームのコンボボックスから選択できるようにするマクロの、別バージョンです。
Private Sub USSaveID1()
'【機能】ID、コンボ_フィールド名1、検索テキスト1を退避
'【変数】
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_CR医療費IDテーブルの最大レコード数
Dim tmpID1, tmpFieldName_LI1, tmpSearch_Txt ' 1個前のレコード内容
Dim F_医療費CR_ID_List As String ' IDリスト
'【実行コード】
If IsNull([チェック_ID履歴]) Then
[チェック_ID履歴] = False
ElseIf [チェック_ID履歴] Then
Exit Sub
End If
' 新規レコードなら、終了
If Me.NewRecord Then
Exit Sub
End If
Debug.Print "DCount(""*"", ""T_CR医療費ID"")=" & DCount("*", "T_CR医療費ID")
maxRcdNum1 = DCount("*", "T_CR医療費ID") ' T_CR医療費IDテーブルの最大レコード数
Set db = CurrentDb()
' テーブルを開く
Set rs = db.OpenRecordset("T_CR医療費ID", dbOpenDynaset)
rs.MoveFirst ' 先頭レコードへ
rs.MoveLast ' 最終レコードへ
rs.MoveFirst ' 先頭レコードへ
' 「コンボ_ID履歴」コンボボックスを更新
F_医療費CR_ID_List = ""
For i = 1 To maxRcdNum1 Step 1
Debug.Print "i=" & i & " F_医療費CR_ID=" & rs![F_医療費CR_ID]
F_医療費CR_ID_List = F_医療費CR_ID_List & rs![F_医療費CR_ID]
F_医療費CR_ID_List = F_医療費CR_ID_List & " " & DLookup("日付", "T_医療費", "ID=" & rs![F_医療費CR_ID])
F_医療費CR_ID_List = F_医療費CR_ID_List & " 領" & DLookup("領収書番号", "T_医療費", "ID=" & rs![F_医療費CR_ID])
F_医療費CR_ID_List = F_医療費CR_ID_List & " " & DLookup("氏名", "MT_氏名", "氏名ID=" & DLookup("氏名ID", "T_医療費", "ID=" & rs![F_医療費CR_ID]))
F_医療費CR_ID_List = F_医療費CR_ID_List & " " & Left(DLookup("病院名", "MT_病院", "病院ID=" & DLookup("病院ID", "T_医療費", "ID=" & rs![F_医療費CR_ID])), 10)
If i <> maxRcdNum1 Then
F_医療費CR_ID_List = F_医療費CR_ID_List & ";"
rs.MoveNext ' 次のレコードへ
End If
Next i
' 値集合タイプ
Forms!F_医療費!コンボ_ID履歴.RowSourceType = "Value List"
' 値集合ソース
Forms!F_医療費!コンボ_ID履歴.RowSource = F_医療費CR_ID_List
Debug.Print "ID=" & [ID]
rs.FindFirst "F_医療費CR_ID=" & [ID] ' 退避済のIDか探索
Debug.Print "rs.AbsolutePosition=" & rs.AbsolutePosition
Debug.Print "rs.NoMatch=" & rs.NoMatch
' 退避済のIDでなければ、T_CR医療費ID_ID=maxRcdNum1(10)-1, - 1を1つ後ろにずらして、T_CR医療費ID_ID=1に退避
' 退避済のIDなら、T_CR医療費ID_ID=rs.AbsolutePosition, - 1を1つ後ろにずらして、T_CR医療費ID_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_CR医療費ID_ID=" & i
If rs.NoMatch Then
Ans = MsgBox("T_CR医療費ID_ID=" & i & "が見つかりません。[USSaveID1]", vbCritical, "エラー")
Exit For
Else
If i = 1 Then
rs.Edit ' 編集用のバッファを用意
rs![F_医療費CR_ID] = [ID] ' IDを退避
rs![FieldName1_LI] = [コンボ_フィールド名1].ListIndex ' コンボ_フィールド名1のLinsIndexを退避
rs![検索テキスト1] = [検索テキスト1].Value ' 検索テキストを退避
rs.Update ' 変更内容を保存
Else
rs.MoveFirst ' 先頭レコードへ
j = i - 1
rs.FindFirst "T_CR医療費ID_ID=" & j
If rs.NoMatch Then
Ans = MsgBox("T_CR医療費ID_ID=" & j & "が見つかりません。[USSaveID1]", vbCritical, "エラー")
Exit For
End If
' 1個前のレコードを退避
tmpID1 = rs![F_医療費CR_ID]
tmpFieldName_LI1 = rs![FieldName1_LI]
tmpSearch_Txt = rs![検索テキスト1]
' 次のレコードへ
rs.FindFirst "T_CR医療費ID_ID=" & i
' 次のレコードへコピー
rs.Edit ' 編集用のバッファを用意
rs![F_医療費CR_ID] = tmpID1
rs![FieldName1_LI] = tmpFieldName_LI1
rs![検索テキスト1] = tmpSearch_Txt
rs.Update ' 変更内容を保存
End If
End If
Next i
' コンボボックスを更新
F_医療費CR_ID_List = ""
rs.MoveFirst ' 先頭レコードへ
For i = 1 To maxRcdNum1 Step 1
Debug.Print "i=" & i & " F_医療費CR_ID=" & rs![F_医療費CR_ID]
F_医療費CR_ID_List = F_医療費CR_ID_List & rs![F_医療費CR_ID]
F_医療費CR_ID_List = F_医療費CR_ID_List & " " & DLookup("日付", "T_医療費", "ID=" & rs![F_医療費CR_ID])
F_医療費CR_ID_List = F_医療費CR_ID_List & " 領" & DLookup("領収書番号", "T_医療費", "ID=" & rs![F_医療費CR_ID])
F_医療費CR_ID_List = F_医療費CR_ID_List & " " & DLookup("氏名", "MT_氏名", "氏名ID=" & DLookup("氏名ID", "T_医療費", "ID=" & rs![F_医療費CR_ID]))
F_医療費CR_ID_List = F_医療費CR_ID_List & " " & Left(DLookup("病院名", "MT_病院", "病院ID=" & DLookup("病院ID", "T_医療費", "ID=" & rs![F_医療費CR_ID])), 10)
If i <> maxRcdNum1 Then
F_医療費CR_ID_List = F_医療費CR_ID_List & ";"
rs.MoveNext ' 次のレコードへ
End If
Next i
' 値集合タイプ
Forms!F_医療費!コンボ_ID履歴.RowSourceType = "Value List"
' 値集合ソース
Forms!F_医療費!コンボ_ID履歴.RowSource = F_医療費CR_ID_List
rs.Close
Set rs = Nothing ' 解放
db.Close
Set db = Nothing ' 解放
[コンボ_ID履歴].SetFocus
[コンボ_ID履歴].ListIndex = 0
[次のレコード].SetFocus
End Sub
https://cheese999.blog.so-net.ne.jp/2018-10-05
で紹介した、フォームで開いているテーブルAの閲覧履歴を別テーブルBに残して、フォームのコンボボックスから選択できるようにするマクロの、別バージョンです。
Private Sub USSaveID1()
'【機能】ID、コンボ_フィールド名1、検索テキスト1を退避
'【変数】
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_CR医療費IDテーブルの最大レコード数
Dim tmpID1, tmpFieldName_LI1, tmpSearch_Txt ' 1個前のレコード内容
Dim F_医療費CR_ID_List As String ' IDリスト
'【実行コード】
If IsNull([チェック_ID履歴]) Then
[チェック_ID履歴] = False
ElseIf [チェック_ID履歴] Then
Exit Sub
End If
' 新規レコードなら、終了
If Me.NewRecord Then
Exit Sub
End If
Debug.Print "DCount(""*"", ""T_CR医療費ID"")=" & DCount("*", "T_CR医療費ID")
maxRcdNum1 = DCount("*", "T_CR医療費ID") ' T_CR医療費IDテーブルの最大レコード数
Set db = CurrentDb()
' テーブルを開く
Set rs = db.OpenRecordset("T_CR医療費ID", dbOpenDynaset)
rs.MoveFirst ' 先頭レコードへ
rs.MoveLast ' 最終レコードへ
rs.MoveFirst ' 先頭レコードへ
' 「コンボ_ID履歴」コンボボックスを更新
F_医療費CR_ID_List = ""
For i = 1 To maxRcdNum1 Step 1
Debug.Print "i=" & i & " F_医療費CR_ID=" & rs![F_医療費CR_ID]
F_医療費CR_ID_List = F_医療費CR_ID_List & rs![F_医療費CR_ID]
F_医療費CR_ID_List = F_医療費CR_ID_List & " " & DLookup("日付", "T_医療費", "ID=" & rs![F_医療費CR_ID])
F_医療費CR_ID_List = F_医療費CR_ID_List & " 領" & DLookup("領収書番号", "T_医療費", "ID=" & rs![F_医療費CR_ID])
F_医療費CR_ID_List = F_医療費CR_ID_List & " " & DLookup("氏名", "MT_氏名", "氏名ID=" & DLookup("氏名ID", "T_医療費", "ID=" & rs![F_医療費CR_ID]))
F_医療費CR_ID_List = F_医療費CR_ID_List & " " & Left(DLookup("病院名", "MT_病院", "病院ID=" & DLookup("病院ID", "T_医療費", "ID=" & rs![F_医療費CR_ID])), 10)
If i <> maxRcdNum1 Then
F_医療費CR_ID_List = F_医療費CR_ID_List & ";"
rs.MoveNext ' 次のレコードへ
End If
Next i
' 値集合タイプ
Forms!F_医療費!コンボ_ID履歴.RowSourceType = "Value List"
' 値集合ソース
Forms!F_医療費!コンボ_ID履歴.RowSource = F_医療費CR_ID_List
Debug.Print "ID=" & [ID]
rs.FindFirst "F_医療費CR_ID=" & [ID] ' 退避済のIDか探索
Debug.Print "rs.AbsolutePosition=" & rs.AbsolutePosition
Debug.Print "rs.NoMatch=" & rs.NoMatch
' 退避済のIDでなければ、T_CR医療費ID_ID=maxRcdNum1(10)-1, - 1を1つ後ろにずらして、T_CR医療費ID_ID=1に退避
' 退避済のIDなら、T_CR医療費ID_ID=rs.AbsolutePosition, - 1を1つ後ろにずらして、T_CR医療費ID_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_CR医療費ID_ID=" & i
If rs.NoMatch Then
Ans = MsgBox("T_CR医療費ID_ID=" & i & "が見つかりません。[USSaveID1]", vbCritical, "エラー")
Exit For
Else
If i = 1 Then
rs.Edit ' 編集用のバッファを用意
rs![F_医療費CR_ID] = [ID] ' IDを退避
rs![FieldName1_LI] = [コンボ_フィールド名1].ListIndex ' コンボ_フィールド名1のLinsIndexを退避
rs![検索テキスト1] = [検索テキスト1].Value ' 検索テキストを退避
rs.Update ' 変更内容を保存
Else
rs.MoveFirst ' 先頭レコードへ
j = i - 1
rs.FindFirst "T_CR医療費ID_ID=" & j
If rs.NoMatch Then
Ans = MsgBox("T_CR医療費ID_ID=" & j & "が見つかりません。[USSaveID1]", vbCritical, "エラー")
Exit For
End If
' 1個前のレコードを退避
tmpID1 = rs![F_医療費CR_ID]
tmpFieldName_LI1 = rs![FieldName1_LI]
tmpSearch_Txt = rs![検索テキスト1]
' 次のレコードへ
rs.FindFirst "T_CR医療費ID_ID=" & i
' 次のレコードへコピー
rs.Edit ' 編集用のバッファを用意
rs![F_医療費CR_ID] = tmpID1
rs![FieldName1_LI] = tmpFieldName_LI1
rs![検索テキスト1] = tmpSearch_Txt
rs.Update ' 変更内容を保存
End If
End If
Next i
' コンボボックスを更新
F_医療費CR_ID_List = ""
rs.MoveFirst ' 先頭レコードへ
For i = 1 To maxRcdNum1 Step 1
Debug.Print "i=" & i & " F_医療費CR_ID=" & rs![F_医療費CR_ID]
F_医療費CR_ID_List = F_医療費CR_ID_List & rs![F_医療費CR_ID]
F_医療費CR_ID_List = F_医療費CR_ID_List & " " & DLookup("日付", "T_医療費", "ID=" & rs![F_医療費CR_ID])
F_医療費CR_ID_List = F_医療費CR_ID_List & " 領" & DLookup("領収書番号", "T_医療費", "ID=" & rs![F_医療費CR_ID])
F_医療費CR_ID_List = F_医療費CR_ID_List & " " & DLookup("氏名", "MT_氏名", "氏名ID=" & DLookup("氏名ID", "T_医療費", "ID=" & rs![F_医療費CR_ID]))
F_医療費CR_ID_List = F_医療費CR_ID_List & " " & Left(DLookup("病院名", "MT_病院", "病院ID=" & DLookup("病院ID", "T_医療費", "ID=" & rs![F_医療費CR_ID])), 10)
If i <> maxRcdNum1 Then
F_医療費CR_ID_List = F_医療費CR_ID_List & ";"
rs.MoveNext ' 次のレコードへ
End If
Next i
' 値集合タイプ
Forms!F_医療費!コンボ_ID履歴.RowSourceType = "Value List"
' 値集合ソース
Forms!F_医療費!コンボ_ID履歴.RowSource = F_医療費CR_ID_List
rs.Close
Set rs = Nothing ' 解放
db.Close
Set db = Nothing ' 解放
[コンボ_ID履歴].SetFocus
[コンボ_ID履歴].ListIndex = 0
[次のレコード].SetFocus
End Sub
2018-11-16 06:02
ヤバイぜ!(14)
コメント(1)
ヤバイぜ! ありがとうございます(^_0)ノ
by cheese999 (2018-11-18 08:13)