アクセス小僧：履歴を残す(6) [コンピューター]
アクセス小僧：アクセス小僧：履歴を残す(2)
https://cheese999.blog.so-net.ne.jp/2018-10-05
で、フォームにて、参照したレコードのID（主キー）の履歴を別テーブル（以下、履歴テーブルと記す）に残して、コンボボックスに反映し、戻りたいときに、すぐ戻れるようにするためのマクロを変更したことを紹介しました。
しかし、問題が１つあって、フォームを読み込んだときのForm_Loadイベントで、履歴テーブルの1番目のレコードを表示させようとすると、それより先に、フォームに関連付けられているテーブル（以下、主テーブルと記す）の先頭レコードに移動したことによるレコード移動(Form_Current)イベントが発動し、履歴テーブルの1番目のレコードが、主テーブルの先頭レコードのIDに書き換わってしまい、フォームに表示されるのが、主テーブルの先頭レコードになってしまいます。
そこで、以下の変更をしてみました。
変更１：履歴テーブルに、Form_Loadイベントの処理中であることを示すフラグ(Form_Load_Flag)を追加。
変更２：Form_Loadイベントのマクロの先頭で、Form_Load_Flagをセット(False→True)
変更３：Form_Loadイベントのマクロを終了、または、途中で抜けるとき、Form_Load_Flagをリセット(True→False)
変更４：履歴テーブルを更新するマクロの先頭で、Form_Load_Flagを参照。フラグがセット(True)されている場合は、マクロを抜ける。
当初の予定では、上記４点の変更でうまくいくはずでした。しかし、うまくいかなかったので、追加で以下の変更をしました。
変更５：履歴テーブルを更新するマクロで、退避しようとしているIDが退避済、かつ、主テーブルの先頭レコードのIDの場合、IDを退避しない。
変更６：Form_Currentイベントのマクロの最後で、履歴の先頭レコードへ飛ぶ処理を追加。
マクロ１：Form_Loadイベントのマクロ
Private Sub Form_Load()
'【イベント】フォーム読み込み時
'【変数】
Dim MyStr1 As String
Dim ReceiptNo As Long ' 領収書番号
Dim myMonth1(1) As Long ' 月
Dim myYear1(1) As Long ' 年
Dim myQueryName1 As String ' クエリ名
Dim acDataSheet
Dim dRs2 As DAO.Recordset2
Dim myFlag1 As Long
Dim i As Long
Dim Ans As Long ' 答え
Dim db As DAO.Database
Dim rs As DAO.Recordset
'【実行コード】
Debug.Print "--- Form_Load(start) ---"
' 現在のデータベース
Set db = CurrentDb()
' テーブルを開く
Set rs = db.OpenRecordset("T_CR医療費ID", dbOpenDynaset)
rs.MoveFirst ' 先頭レコードへ
rs.Edit ' 編集用のバッファを用意
rs![Form_Load_Flag] = True ' フラグをセット（変更１）
rs.Update ' 変更内容を保存
rs.Close
Set rs = Nothing ' 解放
db.Close
Set db = Nothing ' 解放
Debug.Print "Form_Load_Flag=" & DLookup("Form_Load_Flag", "T_CR医療費ID", "T_CR医療費ID_ID=1") & "[Form_Load]"
' 最終レコードへ
'DoCmd.GoToRecord , , acLast
' 直前に参照していたレコードのレコード番号を調べる
Set db = CurrentDb()
' テーブルを開く
Set rs = db.OpenRecordset("T_医療費", dbOpenDynaset)
rs.MoveFirst ' 先頭レコードへ
rs.MoveLast ' 最終レコードへ
rs.MoveFirst ' 先頭レコードへ
' 直前に参照していたレコードのID
MyStr1 = "ID = " & DLookup("F_医療費CR_ID", "T_CR医療費ID", "T_CR医療費ID_ID=1")
Debug.Print "MyStr1=" & MyStr1 & "[Form_Load]"
' IDを検索
rs.FindFirst MyStr1
' IDが見つからなかった場合
If rs.NoMatch Then
Ans = MsgBox(MyStr1 & "は存在しません。", vbExclamation, "注目！")
rs.Close
Set rs = Nothing ' 解放
db.Close
Set db = Nothing ' 解放
Call Rst_FmLdFlg1 ' Form_Load_Flagをリセット（変更３）
Debug.Print "Form_Load_Flag=" & DLookup("Form_Load_Flag", "T_CR医療費ID", "T_CR医療費ID_ID=1") & "[Form_Load]"
Exit Sub
End If
' 直前に参照していたレコードにフォーム上で移動
Debug.Print "rs.AbsolutePosition=" & rs.AbsolutePosition & "[Form_Load]"
DoCmd.GoToRecord acDataForm, "F_医療費", acGoTo, rs.AbsolutePosition + 1
rs.Close
Set rs = Nothing ' 解放
db.Close
Set db = Nothing ' 解放
If IsDate([日付]) Then
myMonth1(0) = CLng(Month([日付]))
myYear1(0) = CLng(Year([日付]))
Debug.Print "myMonth1(0)=" & myMonth1(0) & "[Form_Load]"
Debug.Print "myYear1(0)=" & myYear1(0) & "[Form_Load]"
Else
Ans = MsgBox("日付の値が日付じゃない。", vbCritical, "エラー")
Call Rst_FmLdFlg1 ' Form_Load_Flagをリセット（変更３）
Debug.Print "Form_Load_Flag=" & DLookup("Form_Load_Flag", "T_CR医療費ID", "T_CR医療費ID_ID=1") & "[Form_Load]"
Exit Sub
End If
' クエリ名
If myMonth1(0) <= 9 Then
myQueryName1 = "Q_病院支払い_yyyy-0" & myMonth1(0) & "集計"
Else
myQueryName1 = "Q_病院支払い_yyyy-" & myMonth1(0) & "集計"
End If
Debug.Print "myQueryName1=" & myQueryName1 & "[Form_Load]"
' クエリ「Q_病院支払い_yyyy-mm集計」が開いているか、確認し、開いていたら、一旦閉じる。
If SysCmd(acSysCmdGetObjectState, acQuery, myQueryName1) _
= acObjStateOpen Then
Ans = MsgBox("クエリ「" & myQueryName1 & "」を一旦、閉じます。", vbExclamation, "注目！")
DoCmd.Close acQuery, myQueryName1
End If
' myYear1(1) : 2個目の年。12月の時、myYear1(0)+1。それ以外、myYear1(0)
' myMonth1(1) : 2個目の月。12月の時、1。それ以外、myMonth1(0)+1
Select Case myMonth1(0)
Case 1 To 11
myYear1(1) = myYear1(0)
myMonth1(1) = myMonth1(0) + 1
Case 12
myYear1(1) = myYear1(0) + 1
myMonth1(1) = 1
Case Else
MsgBox "myMonth1(0)=" & myMonth1(0) & "が範囲外[Form_Load]"
Call Rst_FmLdFlg1 ' Form_Load_Flagをリセット（変更３）
Debug.Print "Form_Load_Flag=" & DLookup("Form_Load_Flag", "T_CR医療費ID", "T_CR医療費ID_ID=1") & "[Form_Load]"
Exit Sub
End Select
' 追加変更許可
Me.追加変更許可.Caption = "追加変更許可"
Me.追加変更許可.BackColor = RGB(209, 234, 240)
Me.AllowAdditions = True ' レコード追加許可
Me.AllowEdits = True ' 変更許可
Me.AllowDeletions = True ' 削除許可
Me.DataEntry = False ' データ入力用じゃない
Me.レコード追加.Enabled = True ' レコード追加ボタン有効化
Me.レコードの複製.Enabled = True ' レコードの複製ボタン有効化
' クエリを開く
Call Form_F_メニュー.Agg_yyyy_mm(myQueryName1, CInt(myYear1(0)), CInt(myMonth1(0)), CInt(myYear1(1)), CInt(myMonth1(1)), 3, 1)
' DoCmd.OpenQuery myQueryName1 ' クエリを開く
ReceiptNo = CLng([領収書番号])
Debug.Print "ReceiptNo=" & ReceiptNo & "[Form_Load]" ' debug
' クエリ結果の中から、領収書番号の一致するレコードを探す
Debug.Print "Application.CurrentObjectName=" & Application.CurrentObjectName & "[Form_Load]"
Set acDataSheet = Application.Screen.ActiveDatasheet
Set dRs2 = acDataSheet.RecordsetClone 'クエリ結果の全レコードを取得
Debug.Print "RecordCount=" & dRs2.RecordCount & "[Form_Load]"
dRs2.MoveFirst ' 先頭レコードへ
dRs2.MoveLast ' 最終レコードへ
dRs2.MoveFirst ' 先頭レコードへ
myFlag1 = 0 ' 見つかっていない
For i = 1 To dRs2.RecordCount
Debug.Print "i=" & i & " " & dRs2.Fields(1).Value & "[Form_Load]"
' 領収書番号が一致したら、For文を抜ける
If CLng(dRs2.Fields(1).Value) = ReceiptNo Then
Debug.Print "i=" & i & " " & dRs2.Fields(1).Value & "[Form_Load]"
myFlag1 = 1 ' 見つかった
Exit For
End If
If i = dRs2.RecordCount Then
Exit For
Else
dRs2.MoveNext ' 次のレコードへ
End If
Next i
If myFlag1 = 1 Then
DoCmd.GoToRecord , , acGoTo, i ' 領収書番号が一致したi番目のレコードに移動
Else
Ans = MsgBox("領収書番号=" & ReceiptNo & "のレコードがありません。", vbExclamation, "注目！")
End If
Call Rst_FmLdFlg1 ' Form_Load_Flagをリセット（変更３）
Debug.Print "Form_Load_Flag=" & DLookup("Form_Load_Flag", "T_CR医療費ID", "T_CR医療費ID_ID=1") & "[Form_Load]"
Debug.Print "--- Form_Load(end) ---"
End Sub
マクロ２：Form_Load_Flagをリセット（変更３）
Sub Rst_FmLdFlg1()
'【機能】Form_Load_FlagをFalseにする
'【変数】
Dim db As DAO.Database
Dim rs As DAO.Recordset
'【実行コード】
Debug.Print "--- Rst_FmLdFlg1(start) ---"
' 現在のデータベース
Set db = CurrentDb()
' テーブルを開く
Set rs = db.OpenRecordset("T_CR医療費ID", dbOpenDynaset)
rs.MoveFirst ' 先頭レコードへ
rs.Edit ' 編集用のバッファを用意
rs![Form_Load_Flag] = False ' フラグをリセット
rs.Update ' 変更内容を保存
rs.Close
Set rs = Nothing ' 解放
db.Close
Set db = Nothing ' 解放
Debug.Print "--- Rst_FmLdFlg1(end) ---"
End Sub
マクロ３：履歴テーブルを更新するマクロ
Private Sub USSaveID1()
'【機能】ID、コンボ_フィールド名1、検索テキスト1を退避
'【変数】
Dim db As DAO.Database
Dim rs, rs2 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リスト
'【実行コード】
Debug.Print "--- USSaveID1(start) ---"
Debug.Print "Form_Load_Flag=" & DLookup("Form_Load_Flag", "T_CR医療費ID", "T_CR医療費ID_ID=1") & "[USSaveID1]"
'Form_Load_Flagが真(-1)なら、マクロを抜ける（変更４）
If DLookup("Form_Load_Flag", "T_CR医療費ID", "T_CR医療費ID_ID=1") = -1 Then
Debug.Print "--- USSaveID1(exit) ---"
Exit Sub
End If
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") & "[USSaveID1]"
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] & "[USSaveID1]"
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] & "[USSaveID1]"
rs.FindFirst "F_医療費CR_ID=" & [ID] ' 退避済のIDか探索
Debug.Print "rs.AbsolutePosition=" & rs.AbsolutePosition & "[USSaveID1]"
Debug.Print "rs.NoMatch=" & rs.NoMatch & "[USSaveID1]"
' 退避済のID、かつ、T_医療費テーブルの先頭レコードの場合、マクロを終了（変更５）
Set rs2 = db.OpenRecordset("T_医療費", dbOpenDynaset)
rs2.FindFirst "ID=" & [ID] ' IDを探索
Debug.Print "rs2.AbsolutePosition=" & rs2.AbsolutePosition & "[USSaveID1]"
Debug.Print "rs2.NoMatch=" & rs2.NoMatch & "[USSaveID1]"
If Not (rs.NoMatch) And rs2.AbsolutePosition = 0 Then
rs.Close
Set rs = Nothing ' 解放
rs2.Close
Set rs2 = Nothing ' 解放
db.Close
Set db = Nothing ' 解放
[コンボ_ID履歴].SetFocus
[コンボ_ID履歴].ListIndex = 0
[次のレコード].SetFocus
Debug.Print "--- USSaveID1(exit) ---"
Exit Sub
End If
' 退避済の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] & "[USSaveID1]"
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 ' 解放
rs2.Close
Set rs2 = Nothing ' 解放
db.Close
Set db = Nothing ' 解放
[コンボ_ID履歴].SetFocus
[コンボ_ID履歴].ListIndex = 0
[次のレコード].SetFocus
Debug.Print "--- USSaveID1(end) ---"
End Sub
マクロ４：レコード移動イベント
Private Sub Form_Current()
'【イベント】レコード移動
'【変数】
Dim myDate1 As Date ' 日付
Dim myYear As Integer ' 年
Dim myMonth As Integer ' 月
Dim myString1 As String ' 文字列
Dim Ans As Integer ' 答え
'【実行コード】
Debug.Print "--- Form_Current(start) ---"
'同じ月のレコード数をカウント
myDate1 = [日付]
myYear = Year(myDate1)
myMonth = Month(myDate1)
Select Case myMonth
Case 12
[月レコード数] = (DCount("*", "T_医療費", "[日付]>=#" & myYear & "/12/1#" _
& " And [日付]<#" & myYear + 1 & "/1/1#"))
Case Else
[月レコード数] = (DCount("*", "T_医療費", "[日付]>=#" & myYear & "/" & myMonth & "/1#" _
& " And [日付]<#" & myYear & "/" & myMonth + 1 & "/1#"))
End Select
[レコードNo] = CurrentRecord & "/" & DCount("*", "T_医療費")
' 日付の変更後の値のデフォルト値として今日の年、月、日を設定
[Year1] = Year(Date) ' 年
[コンボ_月1].SetFocus
[コンボ_月1].ListIndex = Month(Date) - 1 ' 月
[コンボ_日1].SetFocus
[コンボ_日1].ListIndex = Day(Date) - 1 ' 日
[Year2] = Year(Date) ' 年
[コンボ_月2].SetFocus
[コンボ_月2].ListIndex = Month(Date) - 1 ' 月
[コンボ_日2].SetFocus
[コンボ_日2].ListIndex = Day(Date) - 1 ' 日
[Btn_検索フィルタ解除].SetFocus
' SendKeys "{TAB}" ' [コンボ_日2]の次のコントロールへフォーカス移動
' 年月日（その１）
myString1 = [Year1] & "/" & ([コンボ_月1].ListIndex + 1) & "/" & ([コンボ_日1].ListIndex + 1)
If IsDate(myString1) Then
'曜日を更新
[テキスト_日1] = "日 [" & UFWeekday1(myString1) & "]"
' 年号を更新
[テキスト_年1] = Format(myString1, "\[ggge""]年""")
Else
Ans = MsgBox("その日付(" & myString1 & ")は存在しません", vbExclamation, "だめよ")
'曜日を更新
[テキスト_日1] = "日 [－]"
' 年号を更新
[テキスト_年1] = "[???]年"
End If
' 年月日（その２）
myString1 = [Year2] & "/" & ([コンボ_月2].ListIndex + 1) & "/" & ([コンボ_日2].ListIndex + 1)
If IsDate(myString1) Then
'曜日を更新
[テキスト_日2] = "日 [" & UFWeekday1(myString1) & "]"
' 年号を更新
[テキスト_年2] = Format(myString1, "\[ggge""]年""")
Else
Ans = MsgBox("その日付(" & myString1 & ")は存在しません", vbExclamation, "だめよ")
'曜日を更新
[テキスト_日2] = "日 [－]"
' 年号を更新
[テキスト_年2] = "[???]年"
End If
' レコードをロードした日時を更新
[テキスト_ロード日時408] = Format(Now(), "yyyy\[ggge""]年""mm\月dd""日[") _
& UFWeekday1(Now()) _
& Format(Now(), "\] hh\:nn\:ss")
' MsgBox "ID=" & [ID]
' ID、コンボ_フィールド名1、検索テキスト1を退避
Call USSaveID1
' 履歴の先頭レコードへ（変更６）
[コンボ_ID履歴].SetFocus
[コンボ_ID履歴].ListIndex = 0
Call コマンド_ID履歴Go_Click
Debug.Print "--- Form_Current(end) ---"
End Sub
今回の変更にあたっては、マクロのいろんなところにdebug.printを埋め込んで、どういう順番でマクロが起動されるか、見ながら変更を行いました。 以下、フォームを開いたときの一連のdebug.printです。
--- Form_Load(start) ---
Form_Load_Flag=-1[Form_Load]
MyStr1=ID = 98[Form_Load]
rs.AbsolutePosition=2[Form_Load]
--- Form_Current(start) ---
--- USSaveID1(start) ---
Form_Load_Flag=-1[USSaveID1]
--- USSaveID1(exit) ---
[コンボ_ID履歴].ListIndex=0 F_医療費CR_IDt=98
--- Form_Current(end) ---
myMonth1(0)=1[Form_Load]
myYear1(0)=2019[Form_Load]
myQueryName1=Q_病院支払い_yyyy-01集計[Form_Load]
--- Form_Current(start) ---
--- USSaveID1(start) ---
Form_Load_Flag=-1[USSaveID1]
--- USSaveID1(exit) ---
[コンボ_ID履歴].ListIndex=0 F_医療費CR_IDt=98
--- Form_Current(start) ---
--- USSaveID1(start) ---
Form_Load_Flag=-1[USSaveID1]
--- USSaveID1(exit) ---
[コンボ_ID履歴].ListIndex=0 F_医療費CR_IDt=98
--- Form_Current(end) ---
--- Form_Current(end) ---
--- Form_Current(start) ---
--- USSaveID1(start) ---
Form_Load_Flag=-1[USSaveID1]
--- USSaveID1(exit) ---
[コンボ_ID履歴].ListIndex=0 F_医療費CR_IDt=98
--- Form_Current(start) ---
--- USSaveID1(start) ---
Form_Load_Flag=-1[USSaveID1]
--- USSaveID1(exit) ---
[コンボ_ID履歴].ListIndex=0 F_医療費CR_IDt=98
--- Form_Current(end) ---
--- Form_Current(end) ---
ReceiptNo=3[Form_Load]
Application.CurrentObjectName=Q_病院支払い_yyyy-01集計[Form_Load]
RecordCount=12[Form_Load]
i=1 1[Form_Load]
i=2 2[Form_Load]
i=3 3[Form_Load]
i=3 3[Form_Load]
--- Rst_FmLdFlg1(start) ---
--- Rst_FmLdFlg1(end) ---
Form_Load_Flag=0[Form_Load]
--- Form_Load(end) ---
--- Form_Current(start) ---
--- USSaveID1(start) ---
Form_Load_Flag=0[USSaveID1]
DCount("*", "T_CR医療費ID")=10[USSaveID1]
i=1 F_医療費CR_ID=98[USSaveID1]
i=2 F_医療費CR_ID=97[USSaveID1]
i=3 F_医療費CR_ID=96[USSaveID1]
i=4 F_医療費CR_ID=99[USSaveID1]
i=5 F_医療費CR_ID=117[USSaveID1]
i=6 F_医療費CR_ID=118[USSaveID1]
i=7 F_医療費CR_ID=116[USSaveID1]
i=8 F_医療費CR_ID=115[USSaveID1]
i=9 F_医療費CR_ID=114[USSaveID1]
i=10 F_医療費CR_ID=113[USSaveID1]
ID=98[USSaveID1]
rs.AbsolutePosition=0[USSaveID1]
rs.NoMatch=False[USSaveID1]
rs2.AbsolutePosition=2[USSaveID1]
rs2.NoMatch=False[USSaveID1]
i=1 F_医療費CR_ID=98[USSaveID1]
i=2 F_医療費CR_ID=97[USSaveID1]
i=3 F_医療費CR_ID=96[USSaveID1]
i=4 F_医療費CR_ID=99[USSaveID1]
i=5 F_医療費CR_ID=117[USSaveID1]
i=6 F_医療費CR_ID=118[USSaveID1]
i=7 F_医療費CR_ID=116[USSaveID1]
i=8 F_医療費CR_ID=115[USSaveID1]
i=9 F_医療費CR_ID=114[USSaveID1]
i=10 F_医療費CR_ID=113[USSaveID1]
--- USSaveID1(end) ---
[コンボ_ID履歴].ListIndex=0 F_医療費CR_IDt=98
--- Form_Current(end) ---
https://cheese999.blog.so-net.ne.jp/2018-10-05
で、フォームにて、参照したレコードのID（主キー）の履歴を別テーブル（以下、履歴テーブルと記す）に残して、コンボボックスに反映し、戻りたいときに、すぐ戻れるようにするためのマクロを変更したことを紹介しました。
しかし、問題が１つあって、フォームを読み込んだときのForm_Loadイベントで、履歴テーブルの1番目のレコードを表示させようとすると、それより先に、フォームに関連付けられているテーブル（以下、主テーブルと記す）の先頭レコードに移動したことによるレコード移動(Form_Current)イベントが発動し、履歴テーブルの1番目のレコードが、主テーブルの先頭レコードのIDに書き換わってしまい、フォームに表示されるのが、主テーブルの先頭レコードになってしまいます。
そこで、以下の変更をしてみました。
変更１：履歴テーブルに、Form_Loadイベントの処理中であることを示すフラグ(Form_Load_Flag)を追加。
変更２：Form_Loadイベントのマクロの先頭で、Form_Load_Flagをセット(False→True)
変更３：Form_Loadイベントのマクロを終了、または、途中で抜けるとき、Form_Load_Flagをリセット(True→False)
変更４：履歴テーブルを更新するマクロの先頭で、Form_Load_Flagを参照。フラグがセット(True)されている場合は、マクロを抜ける。
当初の予定では、上記４点の変更でうまくいくはずでした。しかし、うまくいかなかったので、追加で以下の変更をしました。
変更５：履歴テーブルを更新するマクロで、退避しようとしているIDが退避済、かつ、主テーブルの先頭レコードのIDの場合、IDを退避しない。
変更６：Form_Currentイベントのマクロの最後で、履歴の先頭レコードへ飛ぶ処理を追加。
マクロ１：Form_Loadイベントのマクロ
Private Sub Form_Load()
'【イベント】フォーム読み込み時
'【変数】
Dim MyStr1 As String
Dim ReceiptNo As Long ' 領収書番号
Dim myMonth1(1) As Long ' 月
Dim myYear1(1) As Long ' 年
Dim myQueryName1 As String ' クエリ名
Dim acDataSheet
Dim dRs2 As DAO.Recordset2
Dim myFlag1 As Long
Dim i As Long
Dim Ans As Long ' 答え
Dim db As DAO.Database
Dim rs As DAO.Recordset
'【実行コード】
Debug.Print "--- Form_Load(start) ---"
' 現在のデータベース
Set db = CurrentDb()
' テーブルを開く
Set rs = db.OpenRecordset("T_CR医療費ID", dbOpenDynaset)
rs.MoveFirst ' 先頭レコードへ
rs.Edit ' 編集用のバッファを用意
rs![Form_Load_Flag] = True ' フラグをセット（変更１）
rs.Update ' 変更内容を保存
rs.Close
Set rs = Nothing ' 解放
db.Close
Set db = Nothing ' 解放
Debug.Print "Form_Load_Flag=" & DLookup("Form_Load_Flag", "T_CR医療費ID", "T_CR医療費ID_ID=1") & "[Form_Load]"
' 最終レコードへ
'DoCmd.GoToRecord , , acLast
' 直前に参照していたレコードのレコード番号を調べる
Set db = CurrentDb()
' テーブルを開く
Set rs = db.OpenRecordset("T_医療費", dbOpenDynaset)
rs.MoveFirst ' 先頭レコードへ
rs.MoveLast ' 最終レコードへ
rs.MoveFirst ' 先頭レコードへ
' 直前に参照していたレコードのID
MyStr1 = "ID = " & DLookup("F_医療費CR_ID", "T_CR医療費ID", "T_CR医療費ID_ID=1")
Debug.Print "MyStr1=" & MyStr1 & "[Form_Load]"
' IDを検索
rs.FindFirst MyStr1
' IDが見つからなかった場合
If rs.NoMatch Then
Ans = MsgBox(MyStr1 & "は存在しません。", vbExclamation, "注目！")
rs.Close
Set rs = Nothing ' 解放
db.Close
Set db = Nothing ' 解放
Call Rst_FmLdFlg1 ' Form_Load_Flagをリセット（変更３）
Debug.Print "Form_Load_Flag=" & DLookup("Form_Load_Flag", "T_CR医療費ID", "T_CR医療費ID_ID=1") & "[Form_Load]"
Exit Sub
End If
' 直前に参照していたレコードにフォーム上で移動
Debug.Print "rs.AbsolutePosition=" & rs.AbsolutePosition & "[Form_Load]"
DoCmd.GoToRecord acDataForm, "F_医療費", acGoTo, rs.AbsolutePosition + 1
rs.Close
Set rs = Nothing ' 解放
db.Close
Set db = Nothing ' 解放
If IsDate([日付]) Then
myMonth1(0) = CLng(Month([日付]))
myYear1(0) = CLng(Year([日付]))
Debug.Print "myMonth1(0)=" & myMonth1(0) & "[Form_Load]"
Debug.Print "myYear1(0)=" & myYear1(0) & "[Form_Load]"
Else
Ans = MsgBox("日付の値が日付じゃない。", vbCritical, "エラー")
Call Rst_FmLdFlg1 ' Form_Load_Flagをリセット（変更３）
Debug.Print "Form_Load_Flag=" & DLookup("Form_Load_Flag", "T_CR医療費ID", "T_CR医療費ID_ID=1") & "[Form_Load]"
Exit Sub
End If
' クエリ名
If myMonth1(0) <= 9 Then
myQueryName1 = "Q_病院支払い_yyyy-0" & myMonth1(0) & "集計"
Else
myQueryName1 = "Q_病院支払い_yyyy-" & myMonth1(0) & "集計"
End If
Debug.Print "myQueryName1=" & myQueryName1 & "[Form_Load]"
' クエリ「Q_病院支払い_yyyy-mm集計」が開いているか、確認し、開いていたら、一旦閉じる。
If SysCmd(acSysCmdGetObjectState, acQuery, myQueryName1) _
= acObjStateOpen Then
Ans = MsgBox("クエリ「" & myQueryName1 & "」を一旦、閉じます。", vbExclamation, "注目！")
DoCmd.Close acQuery, myQueryName1
End If
' myYear1(1) : 2個目の年。12月の時、myYear1(0)+1。それ以外、myYear1(0)
' myMonth1(1) : 2個目の月。12月の時、1。それ以外、myMonth1(0)+1
Select Case myMonth1(0)
Case 1 To 11
myYear1(1) = myYear1(0)
myMonth1(1) = myMonth1(0) + 1
Case 12
myYear1(1) = myYear1(0) + 1
myMonth1(1) = 1
Case Else
MsgBox "myMonth1(0)=" & myMonth1(0) & "が範囲外[Form_Load]"
Call Rst_FmLdFlg1 ' Form_Load_Flagをリセット（変更３）
Debug.Print "Form_Load_Flag=" & DLookup("Form_Load_Flag", "T_CR医療費ID", "T_CR医療費ID_ID=1") & "[Form_Load]"
Exit Sub
End Select
' 追加変更許可
Me.追加変更許可.Caption = "追加変更許可"
Me.追加変更許可.BackColor = RGB(209, 234, 240)
Me.AllowAdditions = True ' レコード追加許可
Me.AllowEdits = True ' 変更許可
Me.AllowDeletions = True ' 削除許可
Me.DataEntry = False ' データ入力用じゃない
Me.レコード追加.Enabled = True ' レコード追加ボタン有効化
Me.レコードの複製.Enabled = True ' レコードの複製ボタン有効化
' クエリを開く
Call Form_F_メニュー.Agg_yyyy_mm(myQueryName1, CInt(myYear1(0)), CInt(myMonth1(0)), CInt(myYear1(1)), CInt(myMonth1(1)), 3, 1)
' DoCmd.OpenQuery myQueryName1 ' クエリを開く
ReceiptNo = CLng([領収書番号])
Debug.Print "ReceiptNo=" & ReceiptNo & "[Form_Load]" ' debug
' クエリ結果の中から、領収書番号の一致するレコードを探す
Debug.Print "Application.CurrentObjectName=" & Application.CurrentObjectName & "[Form_Load]"
Set acDataSheet = Application.Screen.ActiveDatasheet
Set dRs2 = acDataSheet.RecordsetClone 'クエリ結果の全レコードを取得
Debug.Print "RecordCount=" & dRs2.RecordCount & "[Form_Load]"
dRs2.MoveFirst ' 先頭レコードへ
dRs2.MoveLast ' 最終レコードへ
dRs2.MoveFirst ' 先頭レコードへ
myFlag1 = 0 ' 見つかっていない
For i = 1 To dRs2.RecordCount
Debug.Print "i=" & i & " " & dRs2.Fields(1).Value & "[Form_Load]"
' 領収書番号が一致したら、For文を抜ける
If CLng(dRs2.Fields(1).Value) = ReceiptNo Then
Debug.Print "i=" & i & " " & dRs2.Fields(1).Value & "[Form_Load]"
myFlag1 = 1 ' 見つかった
Exit For
End If
If i = dRs2.RecordCount Then
Exit For
Else
dRs2.MoveNext ' 次のレコードへ
End If
Next i
If myFlag1 = 1 Then
DoCmd.GoToRecord , , acGoTo, i ' 領収書番号が一致したi番目のレコードに移動
Else
Ans = MsgBox("領収書番号=" & ReceiptNo & "のレコードがありません。", vbExclamation, "注目！")
End If
Call Rst_FmLdFlg1 ' Form_Load_Flagをリセット（変更３）
Debug.Print "Form_Load_Flag=" & DLookup("Form_Load_Flag", "T_CR医療費ID", "T_CR医療費ID_ID=1") & "[Form_Load]"
Debug.Print "--- Form_Load(end) ---"
End Sub
マクロ２：Form_Load_Flagをリセット（変更３）
Sub Rst_FmLdFlg1()
'【機能】Form_Load_FlagをFalseにする
'【変数】
Dim db As DAO.Database
Dim rs As DAO.Recordset
'【実行コード】
Debug.Print "--- Rst_FmLdFlg1(start) ---"
' 現在のデータベース
Set db = CurrentDb()
' テーブルを開く
Set rs = db.OpenRecordset("T_CR医療費ID", dbOpenDynaset)
rs.MoveFirst ' 先頭レコードへ
rs.Edit ' 編集用のバッファを用意
rs![Form_Load_Flag] = False ' フラグをリセット
rs.Update ' 変更内容を保存
rs.Close
Set rs = Nothing ' 解放
db.Close
Set db = Nothing ' 解放
Debug.Print "--- Rst_FmLdFlg1(end) ---"
End Sub
マクロ３：履歴テーブルを更新するマクロ
Private Sub USSaveID1()
'【機能】ID、コンボ_フィールド名1、検索テキスト1を退避
'【変数】
Dim db As DAO.Database
Dim rs, rs2 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リスト
'【実行コード】
Debug.Print "--- USSaveID1(start) ---"
Debug.Print "Form_Load_Flag=" & DLookup("Form_Load_Flag", "T_CR医療費ID", "T_CR医療費ID_ID=1") & "[USSaveID1]"
'Form_Load_Flagが真(-1)なら、マクロを抜ける（変更４）
If DLookup("Form_Load_Flag", "T_CR医療費ID", "T_CR医療費ID_ID=1") = -1 Then
Debug.Print "--- USSaveID1(exit) ---"
Exit Sub
End If
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") & "[USSaveID1]"
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] & "[USSaveID1]"
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] & "[USSaveID1]"
rs.FindFirst "F_医療費CR_ID=" & [ID] ' 退避済のIDか探索
Debug.Print "rs.AbsolutePosition=" & rs.AbsolutePosition & "[USSaveID1]"
Debug.Print "rs.NoMatch=" & rs.NoMatch & "[USSaveID1]"
' 退避済のID、かつ、T_医療費テーブルの先頭レコードの場合、マクロを終了（変更５）
Set rs2 = db.OpenRecordset("T_医療費", dbOpenDynaset)
rs2.FindFirst "ID=" & [ID] ' IDを探索
Debug.Print "rs2.AbsolutePosition=" & rs2.AbsolutePosition & "[USSaveID1]"
Debug.Print "rs2.NoMatch=" & rs2.NoMatch & "[USSaveID1]"
If Not (rs.NoMatch) And rs2.AbsolutePosition = 0 Then
rs.Close
Set rs = Nothing ' 解放
rs2.Close
Set rs2 = Nothing ' 解放
db.Close
Set db = Nothing ' 解放
[コンボ_ID履歴].SetFocus
[コンボ_ID履歴].ListIndex = 0
[次のレコード].SetFocus
Debug.Print "--- USSaveID1(exit) ---"
Exit Sub
End If
' 退避済の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] & "[USSaveID1]"
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 ' 解放
rs2.Close
Set rs2 = Nothing ' 解放
db.Close
Set db = Nothing ' 解放
[コンボ_ID履歴].SetFocus
[コンボ_ID履歴].ListIndex = 0
[次のレコード].SetFocus
Debug.Print "--- USSaveID1(end) ---"
End Sub
マクロ４：レコード移動イベント
Private Sub Form_Current()
'【イベント】レコード移動
'【変数】
Dim myDate1 As Date ' 日付
Dim myYear As Integer ' 年
Dim myMonth As Integer ' 月
Dim myString1 As String ' 文字列
Dim Ans As Integer ' 答え
'【実行コード】
Debug.Print "--- Form_Current(start) ---"
'同じ月のレコード数をカウント
myDate1 = [日付]
myYear = Year(myDate1)
myMonth = Month(myDate1)
Select Case myMonth
Case 12
[月レコード数] = (DCount("*", "T_医療費", "[日付]>=#" & myYear & "/12/1#" _
& " And [日付]<#" & myYear + 1 & "/1/1#"))
Case Else
[月レコード数] = (DCount("*", "T_医療費", "[日付]>=#" & myYear & "/" & myMonth & "/1#" _
& " And [日付]<#" & myYear & "/" & myMonth + 1 & "/1#"))
End Select
[レコードNo] = CurrentRecord & "/" & DCount("*", "T_医療費")
' 日付の変更後の値のデフォルト値として今日の年、月、日を設定
[Year1] = Year(Date) ' 年
[コンボ_月1].SetFocus
[コンボ_月1].ListIndex = Month(Date) - 1 ' 月
[コンボ_日1].SetFocus
[コンボ_日1].ListIndex = Day(Date) - 1 ' 日
[Year2] = Year(Date) ' 年
[コンボ_月2].SetFocus
[コンボ_月2].ListIndex = Month(Date) - 1 ' 月
[コンボ_日2].SetFocus
[コンボ_日2].ListIndex = Day(Date) - 1 ' 日
[Btn_検索フィルタ解除].SetFocus
' SendKeys "{TAB}" ' [コンボ_日2]の次のコントロールへフォーカス移動
' 年月日（その１）
myString1 = [Year1] & "/" & ([コンボ_月1].ListIndex + 1) & "/" & ([コンボ_日1].ListIndex + 1)
If IsDate(myString1) Then
'曜日を更新
[テキスト_日1] = "日 [" & UFWeekday1(myString1) & "]"
' 年号を更新
[テキスト_年1] = Format(myString1, "\[ggge""]年""")
Else
Ans = MsgBox("その日付(" & myString1 & ")は存在しません", vbExclamation, "だめよ")
'曜日を更新
[テキスト_日1] = "日 [－]"
' 年号を更新
[テキスト_年1] = "[???]年"
End If
' 年月日（その２）
myString1 = [Year2] & "/" & ([コンボ_月2].ListIndex + 1) & "/" & ([コンボ_日2].ListIndex + 1)
If IsDate(myString1) Then
'曜日を更新
[テキスト_日2] = "日 [" & UFWeekday1(myString1) & "]"
' 年号を更新
[テキスト_年2] = Format(myString1, "\[ggge""]年""")
Else
Ans = MsgBox("その日付(" & myString1 & ")は存在しません", vbExclamation, "だめよ")
'曜日を更新
[テキスト_日2] = "日 [－]"
' 年号を更新
[テキスト_年2] = "[???]年"
End If
' レコードをロードした日時を更新
[テキスト_ロード日時408] = Format(Now(), "yyyy\[ggge""]年""mm\月dd""日[") _
& UFWeekday1(Now()) _
& Format(Now(), "\] hh\:nn\:ss")
' MsgBox "ID=" & [ID]
' ID、コンボ_フィールド名1、検索テキスト1を退避
Call USSaveID1
' 履歴の先頭レコードへ（変更６）
[コンボ_ID履歴].SetFocus
[コンボ_ID履歴].ListIndex = 0
Call コマンド_ID履歴Go_Click
Debug.Print "--- Form_Current(end) ---"
End Sub
今回の変更にあたっては、マクロのいろんなところにdebug.printを埋め込んで、どういう順番でマクロが起動されるか、見ながら変更を行いました。 以下、フォームを開いたときの一連のdebug.printです。
--- Form_Load(start) ---
Form_Load_Flag=-1[Form_Load]
MyStr1=ID = 98[Form_Load]
rs.AbsolutePosition=2[Form_Load]
--- Form_Current(start) ---
--- USSaveID1(start) ---
Form_Load_Flag=-1[USSaveID1]
--- USSaveID1(exit) ---
[コンボ_ID履歴].ListIndex=0 F_医療費CR_IDt=98
--- Form_Current(end) ---
myMonth1(0)=1[Form_Load]
myYear1(0)=2019[Form_Load]
myQueryName1=Q_病院支払い_yyyy-01集計[Form_Load]
--- Form_Current(start) ---
--- USSaveID1(start) ---
Form_Load_Flag=-1[USSaveID1]
--- USSaveID1(exit) ---
[コンボ_ID履歴].ListIndex=0 F_医療費CR_IDt=98
--- Form_Current(start) ---
--- USSaveID1(start) ---
Form_Load_Flag=-1[USSaveID1]
--- USSaveID1(exit) ---
[コンボ_ID履歴].ListIndex=0 F_医療費CR_IDt=98
--- Form_Current(end) ---
--- Form_Current(end) ---
--- Form_Current(start) ---
--- USSaveID1(start) ---
Form_Load_Flag=-1[USSaveID1]
--- USSaveID1(exit) ---
[コンボ_ID履歴].ListIndex=0 F_医療費CR_IDt=98
--- Form_Current(start) ---
--- USSaveID1(start) ---
Form_Load_Flag=-1[USSaveID1]
--- USSaveID1(exit) ---
[コンボ_ID履歴].ListIndex=0 F_医療費CR_IDt=98
--- Form_Current(end) ---
--- Form_Current(end) ---
ReceiptNo=3[Form_Load]
Application.CurrentObjectName=Q_病院支払い_yyyy-01集計[Form_Load]
RecordCount=12[Form_Load]
i=1 1[Form_Load]
i=2 2[Form_Load]
i=3 3[Form_Load]
i=3 3[Form_Load]
--- Rst_FmLdFlg1(start) ---
--- Rst_FmLdFlg1(end) ---
Form_Load_Flag=0[Form_Load]
--- Form_Load(end) ---
--- Form_Current(start) ---
--- USSaveID1(start) ---
Form_Load_Flag=0[USSaveID1]
DCount("*", "T_CR医療費ID")=10[USSaveID1]
i=1 F_医療費CR_ID=98[USSaveID1]
i=2 F_医療費CR_ID=97[USSaveID1]
i=3 F_医療費CR_ID=96[USSaveID1]
i=4 F_医療費CR_ID=99[USSaveID1]
i=5 F_医療費CR_ID=117[USSaveID1]
i=6 F_医療費CR_ID=118[USSaveID1]
i=7 F_医療費CR_ID=116[USSaveID1]
i=8 F_医療費CR_ID=115[USSaveID1]
i=9 F_医療費CR_ID=114[USSaveID1]
i=10 F_医療費CR_ID=113[USSaveID1]
ID=98[USSaveID1]
rs.AbsolutePosition=0[USSaveID1]
rs.NoMatch=False[USSaveID1]
rs2.AbsolutePosition=2[USSaveID1]
rs2.NoMatch=False[USSaveID1]
i=1 F_医療費CR_ID=98[USSaveID1]
i=2 F_医療費CR_ID=97[USSaveID1]
i=3 F_医療費CR_ID=96[USSaveID1]
i=4 F_医療費CR_ID=99[USSaveID1]
i=5 F_医療費CR_ID=117[USSaveID1]
i=6 F_医療費CR_ID=118[USSaveID1]
i=7 F_医療費CR_ID=116[USSaveID1]
i=8 F_医療費CR_ID=115[USSaveID1]
i=9 F_医療費CR_ID=114[USSaveID1]
i=10 F_医療費CR_ID=113[USSaveID1]
--- USSaveID1(end) ---
[コンボ_ID履歴].ListIndex=0 F_医療費CR_IDt=98
--- Form_Current(end) ---
ヤバイぜ！ ありがとうございます(^_0)ノ
コンピュータ・プログラミングを行う者として、元号の早期発表に反対する人たちに言いたい。たかが、２文字の変更じゃないか、という意見をお持ちなら、あなたはコンピュータ・プログラミングを知らなすぎる、と言いたい。１文字間違えただけで、止まった例は数えきれないからね。(^_0)ノ
by cheese999 (2019-03-02 15:00)