データ取得後、画面表示時一部項目を空白に(ｻﾌﾞﾌｫｰﾑ)

前提・実現したいこと

履歴からデータを取得後(コピー)、画面表示される際に日付関係を空白にしたい。

サブフォームの納品日を空白にする処理を記述した場合、画面を閉じると
「レコードは削除されています。」とエラーメッセージが表示されます。

登録した場合はエラーメッセージもなく登録されます。

エラーメッセージの表示を消せないか。
あるいはサブフォームの納品日を空白にする処理の方法で別の方法がないか。
解決案を求めています。

該当のソースコード

VBA
1'//////////////////////////////////////////////////////////
2'
3' データ取得
4'
5'//////////////////////////////////////////////////////////
6Private Function GetData(ByVal i_kanri_no As String) As Boolean
7
8On Error GoTo Err_Proc
9
10    Dim strSQL      As String
11    Dim rs          As Recordset
12
13    '=================================================
14    ' データ抽出
15    '=================================================
16    'SQL文字列生成
17    strSQL = "SELECT"
18    strSQL = strSQL & "         a.KANRI_NO,"
19    strSQL = strSQL & "         a.BUSHO_CD,"
20    strSQL = strSQL & "         b.BUSHO_NAME,"
21    strSQL = strSQL & "         a.STAFF_CD,"
22    strSQL = strSQL & "         c.STAFF_NAME,"
23    strSQL = strSQL & "         a.KEIHI_MEISAI,"
24    strSQL = strSQL & "         a.KAMOKU_KBN,"
25    strSQL = strSQL & "         a.SHOHIZEI_KBN,"
26    strSQL = strSQL & "         a.KINGAKU_SHOKEI,"
27    strSQL = strSQL & "         a.KINGAKU_ZEI,"
28    strSQL = strSQL & "         a.KINGAKU_GOKEI,"
29    strSQL = strSQL & "         a.GYOSHA_CD,"
30    strSQL = strSQL & "         d.GYOSHA_NAME,"
31    strSQL = strSQL & "         a.KONYU_JIKI,"
32    strSQL = strSQL & "         a.MITUMORI_UMU,"
33    strSQL = strSQL & "         a.TENPU_SIRYO,"
34    strSQL = strSQL & "         a.SIHARAI_HOHO1,"
35    strSQL = strSQL & "         a.SIHARAI_ETC,"
36    strSQL = strSQL & "         a.SHIHARAI_KIJITU,"
37    strSQL = strSQL & "         a.KEKA_HOKOKU,"
38    strSQL = strSQL & "         a.HOKOKU_JIKI,"
39    strSQL = strSQL & "         a.BIKO,"
40    strSQL = strSQL & "         a.KEIKA,"
41    strSQL = strSQL & "         a.KOKA,"
42    strSQL = strSQL & "         a.SCHEDULE,"
43    strSQL = strSQL & "         a.ETC,"
44    strSQL = strSQL & "         a.SIHARAI_YOTEIBI,"
45    strSQL = strSQL & "         a.KIBO_NOKI,"
46    strSQL = strSQL & "         a.SIHARAI_HOHO2,"
47    strSQL = strSQL & "         a.NONYUSAKI,"
48    strSQL = strSQL & "         a.TEKIYO,"
49    strSQL = strSQL & "         a.SINSEI_DATE,"
50    strSQL = strSQL & "         a.HATYU_DATE"
51    strSQL = strSQL & "    FROM ((TRNTBL_KOBAI AS a"
52    strSQL = strSQL & "         LEFT JOIN MSTTBL_BUSHO AS b ON"
53    strSQL = strSQL & "         a.BUSHO_CD = b.BUSHO_CD)"
54    strSQL = strSQL & "         LEFT JOIN MSTTBL_STAFF AS c ON"
55    strSQL = strSQL & "         a.STAFF_CD = c.STAFF_CD)"
56    strSQL = strSQL & "         LEFT JOIN MSTTBL_GYOSHA AS d ON"
57    strSQL = strSQL & "         a.GYOSHA_CD = d.GYOSHA_CD"
58    strSQL = strSQL & " WHERE KANRI_NO = '" & i_kanri_no & "'"
59
60    'データ取得
61    Set rs = CurrentDb.OpenRecordset(strSQL)
62
63    '値取得
64    If Not rs Is Nothing Then
65        If (rs.RecordCount = 0) Then
66            GetData = False
67            Exit Function
68        End If
69    Else
70        GetData = False
71        Exit Function
72    End If
73
74    '=================================================
75    ' 画面表示
76    '=================================================
77    If (m_shori_mode = COM_SHORI_CODE_UPDATE2) Then 'リピート登録の時　空白を入れる
78        Me.txt_KANRI_NO = Nz(Me.txt_KANRI_NO, "")
79        Me.txt_KONYU_JIKI = Nz(Me.txt_KONYU_JIKI, "")
80        Me.txt_SHIHARAI_KIJITU = Nz(Me.txt_SHIHARAI_KIJITU, "")
81        Me.txt_SINSEI_DATE = Nz(Me.txt_SINSEI_DATE, "")
82        Me.txt_HATYU_DATE = Nz(Me.txt_HATYU_DATE, "")
83    Else
84        Me.txt_KANRI_NO = Nz(rs("KANRI_NO"), "")
85        Me.txt_KONYU_JIKI = Nz(rs("KONYU_JIKI"), "")
86        Me.txt_SHIHARAI_KIJITU = Nz(rs("SHIHARAI_KIJITU"), "")
87        Me.txt_SINSEI_DATE = Nz(rs("SINSEI_DATE"), "")
88        Me.txt_HATYU_DATE = Nz(rs("HATYU_DATE"), "")
89    End If
90    
91    Me.cmb_BUSHO_CD = Nz(rs("BUSHO_CD"), "")
92    Me.txt_BUSHO_NAME = Nz(rs("BUSHO_NAME"), "")
93    Me.txt_STAFF_CD = Nz(rs("STAFF_CD"), "")
94    Me.txt_STAFF_NAME = Nz(rs("STAFF_NAME"), "")
95    Me.txt_KEIHI_MEISAI = Nz(rs("KEIHI_MEISAI"), "")
96    Me.cmb_KAMOKU_KBN = Nz(rs("KAMOKU_KBN"), "")
97    Me.cmb_SHOHIZEI_KBN = Nz(rs("SHOHIZEI_KBN"), "")
98    Me.txt_GYOSHA_CD = Nz(rs("GYOSHA_CD"), "")
99    Me.txt_GYOSHA_NAME = Nz(rs("GYOSHA_NAME"), "")
100    Me.cmb_MITUMORI_UMU = Nz(rs("MITUMORI_UMU"), "")       '見積の有無
101    Me.cmb_TENPU_SIRYO = Nz(rs("TENPU_SIRYO"), "")         '添付資料
102    Me.cmb_SIHARAI_HOHO1 = Nz(rs("SIHARAI_HOHO1"), "")     '支払い方法
103    Me.txt_SIHARAI_ETC = Nz(rs("SIHARAI_ETC"), "")
104    Me.cmb_KEKA_HOKOKU = Nz(rs("KEKA_HOKOKU"), "")        '経費使用後の結果報告
105    Me.txt_HOKOKU_JIKI = Nz(rs("HOKOKU_JIKI"), "")
106    Me.txt_BIKO = Nz(rs("BIKO"), "")
107    Me.txt_KEIKA = Nz(rs("KEIKA"), "")
108    Me.txt_KOKA = Nz(rs("KOKA"), "")
109    Me.txt_SCHEDULE = Nz(rs("SCHEDULE"), "")
110    Me.txt_ETC = Nz(rs("ETC"), "")
111    Me.txt_SIHARAI_YOTEIBI = Nz(rs("SIHARAI_YOTEIBI"), "")
112    Me.txt_KIBO_NOKI = Nz(rs("KIBO_NOKI"), "")
113    Me.txt_SIHARAI_HOHO2 = Nz(rs("SIHARAI_HOHO2"), "")
114    Me.txt_NONYUSAKI = Nz(rs("NONYUSAKI"), "")
115    Me.txt_TEKIYO = Nz(rs("TEKIYO"), "")
116
117    ’ 明細情報　(サブフォーム：sub_trnrbl_meisai)
118    If (InsertWorkData = False) Then
119        MsgBox "データ取得処理(明細項目)でエラーが発生しました。", vbExclamation, "データ表示時エラー"
120        GetData = False
121        GoTo Exit_Proc
122    Else
123        Me.sub_trntbl_meisai.Requery
124        
125        If (m_shori_mode = COM_SHORI_CODE_UPDATE2) Then 'リピート品の時
126            Me.sub_trntbl_meisai.Form!txt_NOHIN_DATE = ""  ’納品日を空白に
127        End If
128        
129    End If
130
131   '戻りセット
132   GetData = True
133
134Exit_Proc:
135   'オブジェクト破棄
136   If Not rs Is Nothing Then
137    Set rs = Nothing
138   End If
139
140    Exit Function
141
142Err_Proc:
143    MsgBox (Err.Description & ", " & Err.Number)
144    '戻りセット
145    GetData = False
146    Resume Exit_Proc
147
148End Function
149
150'//////////////////////////////////////////////////////////
151'
152' ワークテーブルデータ追加処理
153'
154'//////////////////////////////////////////////////////////
155Private Function InsertWorkData() As Boolean
156On Error GoTo Err_Proc
157
158    Dim strSQL                                       As String
159
160    '===============================================
161    ' SQL文字列生成
162    '===============================================
163    strSQL = "INSERT INTO WORKTBL_KOBAI_MEISAI ("
164    strSQL = strSQL & " EDA,"
165    strSQL = strSQL & " SHIYO_NO,"
166    strSQL = strSQL & " HINMEI,"
167    strSQL = strSQL & " TANKA,"
168    strSQL = strSQL & " SURYO,"
169    strSQL = strSQL & " TANI,"
170    strSQL = strSQL & " NOHIN_DATE,"
171    strSQL = strSQL & " BIKO,"
172    strSQL = strSQL & " CHK_ZEI"
173    strSQL = strSQL & " )"
174    strSQL = strSQL & " SELECT"
175    strSQL = strSQL & "             EDA,"
176    strSQL = strSQL & "             SHIYO_NO,"
177    strSQL = strSQL & "             HINMEI,"
178    strSQL = strSQL & "             TANKA,"
179    strSQL = strSQL & "             SURYO,"
180    strSQL = strSQL & "             TANI,"
181    strSQL = strSQL & "             NOHIN_DATE,"
182    strSQL = strSQL & "             BIKO,"
183    strSQL = strSQL & "             CHK_ZEI"
184    strSQL = strSQL & " FROM TRNTBL_KOBAI_MEISAI"
185    strSQL = strSQL & " WHERE TRNTBL_KOBAI_MEISAI.KANRI_NO = '" & m_kanri_no & "'"
186
187    '===============================================
188    ' 更新処理実行
189    '===============================================
190    'SQL実行
191    DoCmd.RunSQL strSQL
192        
193    '戻り値セット
194    InsertWorkData = True
195
196Exit_Proc:
197    Exit Function
198
199Err_Proc:
200    MsgBox (Err.Number & ", " & Err.Description)
201    InsertWorkData = False
202    Resume Exit_Proc
203End Function
204
205'//////////////////////////////////////////////////////////
206'
207' キャンセルボタン：クリック時処理
208'
209'//////////////////////////////////////////////////////////
210Private Sub cmd_cancel_Click()
211On Error GoTo Err_Proc
212
213    ' 確認MSG
214    If (vbYes = MsgBox("登録処理を実行せずに画面を閉じます。" & vbCrLf & "宜しいですか？", vbYesNo, "キャンセル確認")) Then
215        ' 閉じる処理
216        DoCmd.Close
217    End If
218
219Exit_Proc:
220    Exit Sub
221
222Err_Proc:
223    MsgBox (Err.Description & ", " & Err.Number)
224    Resume Exit_Proc
225End Sub
226
227'//////////////////////////////////////////////////////////
228'
229' フォーム：クローズ時処理
230'
231'//////////////////////////////////////////////////////////
232Private Sub Form_Close()
233On Error GoTo Err_Proc
234
235    '==============================
236    ' ワークテーブル削除
237    '==============================
238    If (DeleteData("WORKTBL_KOBAI_MEISAI") = False) Then
239        MsgBox "ワークテーブル削除処理でエラーが発生しました。", vbCritical, "初期化処理"
240    End If
241    
242Exit_Proc:
243    Exit Sub
244
245Err_Proc:
246    MsgBox Err.Description
247    Resume Exit_Proc
248End Sub

試したこと

メインフォームの日付関係は記述しているコードで空白で表示され、エラーもでない。
エラーメッセージが毎回表示されるが履歴データは削除されていない。
サブフォームの納品日を空白にする処理が行われない場合はエラーがでない。

補足情報（FW/ツールのバージョンなど）

Windows10,ACCESS2016

hatena19

2019/05/31 10:02

Markdownのコードタグの言語はSQLではなくVBAに変更してください。

hatena19

2019/05/31 10:06

> サブフォームの納品日を空白にする処理を記述した場合、画面を閉じると > 「レコードは削除されています。」とエラーメッセージが表示されます。とのことですが、「サブフォームの納品日を空白にする処理」のコードはどの部分ですか。提示のコードには、データをフォーム上に表示させるコードと、ワークテーブルにデータを追加するコードしかないようですが。

tera_taro

2019/06/03 00:03

>Markdownのコードタグの言語はSQLではなくVBAに変更してください。変更しました。 >「サブフォームの納品日を空白にする処理」のコードはどの部分ですか。Me.sub_trntbl_meisai.Form!txt_NOHIN_DATE = "" ’納品日を空白にの箇所です。

hatena19

2019/06/03 00:15

あっ、そこですね。見落としてました。エラーがでるのは、そこではなく、フォームを閉じる時ですよね。 On Error GoTo のエラートラップコードをすべてコメントアウトして、実行して、エラーが発生したら、デバックボタンを押して、反転表示されるコードの前後を提示してもらえませんか。

tera_taro

2019/06/03 00:38

フォームを閉じる際のコードを追加しました。「キャンセルボタン：クリック時処理」の DoCmd.Close　後　End Ifの所で On Error GoTo　をコメントアウトしても「レコードは削除されています。」とエラーメッセージが表示されます。コメントアウトしていない場合は、 DoCmd.Close　後　Exit_Proc:のExit Subの所でエラーが出ます。

行動規範の内容に同意します

回答1件

ベストアンサー

提示された情報からだけでは、原因の特定は難しそうですが、とりあえず、下記を試してみてください。

Form_Close内の下記の部分にコードを挿入。

vba
1    '==============================
2    ' ワークテーブル削除
3    '==============================
4
5    '※下記の2行のどちらかを挿入、あるいは、両方とも挿入
6    Me.sub_trntbl_meisai.Form.Refresh
7    Me.sub_trntbl_meisai.Form.RecordSource = ""
8    
9
10    If (DeleteData("WORKTBL_KOBAI_MEISAI") = False) Then
11        MsgBox "ワークテーブル削除処理でエラーが発生しました。", vbCritical, "初期化処理"
12    End If

追記

質問者さんのコメントより、上記のコードの追加でエラーが出なくなったようです。
理由は、
原因となる部分のコードの提示がないので、推測になりますが、
DeleteData("WORKTBL_KOBAI_MEISAI") の DeleteDataプロシージャ内で、ワークテーブルのデータ削除をしていると思います。
削除クエリか、別にReocrdSetを開いて削除しているのだと思います。

サブフォームでワークテーブルと連結していて、更新なり、削除なりの操作をして、それがテーブルに反映する前に、別の場所からテーブルにアクセスして削除したりすると、両者で不整合が発生して不具合の原因になります。
Refresh はフォーム上での更新、削除をテーブルに反映させる効果がありますので、それがエラー改善につながったのだと思います。

投稿2019/06/03 01:17

編集2019/06/03 02:49

hatena19

総合スコア34362

tera_taro

2019/06/03 02:13

エラーが出なくなりました。ありがとうございます！ Refreshを調べてみたのですが、なぜこれでエラーが出なくなるのかよろしければ簡単に説明してもらっても良いですか？納品日を空白にした時の処理を実行していた場合、フォームを閉じる前に納品日を空白にする前のデータを取得するからエラーにならなくなった。とかでしょうか？