So-net無料ブログ作成
  • ブログをはじめる
  • ログイン

アクセス小僧:月の切り替わり [コンピューター]

先日、12月に

なったので、11月の医療費をデータベースに登録しようと思い、アクセスを起動したところ、フォームを読み込んだ
ところで呼び出されるForm_Loadイベントのマクロが実行時エラーとなってしまいました。

【変更前の手順】
1. フォーム呼び出しにより、Form_Loadイベント発生。マクロ起動。
2. 履歴テーブルを参照し、最後に参照したレコード(T_CR医療費ID_ID=1)のIDを調べる
3. 医療費テーブルをレコードセットとして開き、2.で調べたIDのレコード番号を調べる
4. 3.で調べたレコード番号(rs.AbsolutePosition + 1)を元に、フォーム上で、最後に参照していたレコードに移動
5. 移動先のレコードの日付欄から、月を取り出し、その月のレコードを抽出するクエリ(Q_病院支払い_yyyy-mm集計、mmは01, 02 - 12)が開いていたら、閉じる
6. その月のレコードを抽出するクエリ(Q_病院支払い_yyyy-mm集計、mmは01, 02 - 12)を開く
7. クエリ結果の中から、フォームで表示しているレコードと同じ領収書番号を探して、移動

実行時エラーが発生したのは、手順6.のところです。クエリのレコード抽出条件が、2017年の月になっていたため、レコードが1件も抽出されず、エラーとなっていました。

そこで、クエリを開く前に、クエリの抽出条件を変更するように改めました。

【変更後の手順】
1. フォーム呼び出しにより、Form_Loadイベント発生。マクロ起動。
2. 履歴テーブルを参照し、最後に参照したレコード(T_CR医療費ID_ID=1)のIDを調べる
3. 医療費テーブルをレコードセットとして開き、2.で調べたIDのレコード番号を調べる
4. 3.で調べたレコード番号(rs.AbsolutePosition + 1)を元に、フォーム上で、最後に参照していたレコードに移動
5. 移動先のレコードの日付欄から、月を取り出し、その月のレコードを抽出するクエリ(Q_病院支払い_yyyy-mm集計、mmは01, 02 - 12)が開いていたら、閉じる
6(追加). フォーム上で参照しているレコードの日付を元に、その月のレコードを抽出するように、その月のレコードを抽出するクエリ(Q_病院支払い_yyyy-mm集計、mmは01, 02 - 12)を変更する
7. その月のレコードを抽出するクエリ(Q_病院支払い_yyyy-mm集計、mmは01, 02 - 12))を開く
8. クエリ結果の中から、フォームで表示しているレコードと同じ領収書番号を探して、移動

【マクロコード:フォーム呼び出しで起動】

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 ---"
  ' 最終レコードへ
  '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")
  ' IDを検索
  rs.FindFirst MyStr1
  ' IDが見つからなかった場合
  If rs.NoMatch Then
    Ans = MsgBox(MyStr1 & "は存在しません。", vbExclamation, "注目!")
    rs.Close
    Set rs = Nothing ' 解放
    db.Close
    Set db = Nothing ' 解放
    Exit Sub
  End If
  ' 直前に参照していたレコードにフォーム上で移動
  Debug.Print "rs.AbsolutePosition=" & rs.AbsolutePosition
  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)
    Debug.Print "myYear1(0)=" & myYear1(0)
  Else
    Ans = MsgBox("日付の値が日付じゃない。", vbCritical, "エラー")
    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
  ' クエリ「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]"
    Exit Sub
  End Select
  ' クエリを開く
  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 ' debug
  ' クエリ結果の中から、領収書番号の一致するレコードを探す
  Debug.Print "Application.CurrentObjectName=" & Application.CurrentObjectName
  Set acDataSheet = Application.Screen.ActiveDatasheet
  Set dRs2 = acDataSheet.RecordsetClone 'クエリ結果の全レコードを取得
  Debug.Print "RecordCount=" & dRs2.RecordCount
  dRs2.MoveFirst ' 先頭レコードへ
  dRs2.MoveLast ' 最終レコードへ
  dRs2.MoveFirst ' 先頭レコードへ
  myFlag1 = 0 ' 見つかっていない
  For i = 1 To dRs2.RecordCount
    Debug.Print "i=" & i & " " & dRs2.Fields(1).Value
    ' 領収書番号が一致したら、For文を抜ける
    If CLng(dRs2.Fields(1).Value) = ReceiptNo Then
      Debug.Print "i=" & i & " " & dRs2.Fields(1).Value
      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
End Sub

【マクロコード:クエリの年、月を変更】

Public Sub Agg_yyyy_mm(myQuery1 As String, YYYY1 As Integer, MM1 As Integer _
, YYYY2 As Integer, MM2 As Integer, myJogaiMode1 As Integer, mode1)
  ' 【機能】クエリで集計する年月、除外状態を変更
  ' 【引数】
  ' myQuery1 as String : クエリ名
  ' YYYY1, YYYY2 as Integer : 年
  ' MM1, MM2 as Integer : 月
  ' myJogaiMode1 : 除外状態(1:除外しない、2:除外する、3:両方)
  ' mode1 : モード(1:yyyy-mm集計、2:月別集計)
  ' 【変数】
  Dim dbs As Database
  Dim qdf As QueryDef
  Dim strSQL As String
  Dim reg As Object
  Dim rep, v1, v2, MyStr1 As String
  Dim myJogai1, myJogai2 As Boolean ' 除外状態1、除外状態2
  ' 【実行コード】
  ' 除外状態
  Select Case myJogaiMode1
  Case 1 ' 除外しない
    myJogai1 = False
    myJogai2 = False
  Case 2 ' 除外する
    myJogai1 = True
    myJogai2 = True
  Case 3 ' 両方
    myJogai1 = False
    myJogai2 = True
  Case Else
    myJogai1 = False
    myJogai2 = True
  End Select
  ' 正規表現による置換
  Set dbs = CurrentDb ' カレントデータベース
  Set qdf = dbs.QueryDefs(myQuery1) ' クエリ
  ' クエリの現在のSQL文を変数にセット
  strSQL = qdf.SQL
  ' 正規表現オブジェクト作成
  Set reg = CreateObject("VBScript.RegExp")
  Select Case mode1
  Case 1 ' yyyy-mm集計
    ' パターン=「HAVING (((T_医療費.日付)>=#10/1/2017# And (T_医療費.日付)<#11/1/2017#)
    ' AND ((T_医療費.除外)=False Or (T_医療費.除外)=True))」
    MyStr1 = "HAVING\s\(\(\(T_医療費\.日付\)>=#[0-9]+/[0-9]+/[0-9]+#\sAnd\s\(T_医療費\.日付\)<#[0-9]+/[0-9]+/[0-9]+#\)"
    MyStr1 = MyStr1 & "\sA[Nn][Dd]\s\(\(T_医療費\.除外\)=[A-Za-z]+\sO[Rr]\s\(T_医療費\.除外\)=[A-Za-z]+\)\)"
    ' 置換後のパターン(v2)
    v2 = "HAVING (((T_医療費.日付)" & ">=#" & MM1 & "/1/" & YYYY1 & "#" & " And (T_医療費.日付)" & "<#" & MM2 & "/1/" & YYYY2 & "#)"
    v2 = v2 & " AND ((T_医療費.除外)=" & myJogai1 & " Or (T_医療費.除外)=" & myJogai2 & "))"
  Case 2 ' 月別集計
     ' パターン=「HAVING (((Format([日付],"yyyy/mm"))>=2017/1 And (Format([日付],"yyyy/mm"))<2018/1)
     ' AND ((T_医療費.除外)=False Or (T_医療費.除外)=True));」
     MyStr1 = "HAVING\s\(\(\(Format\(\[日付\],""yyyy/mm""\)\)>=[0-9]+/[0-9]+\s*And\s\(Format\(\[日付\],""yyyy/mm""\)\)<[0-9]+/[0-9]+\)"
     MyStr1 = MyStr1 & "\s*A[Nn][Dd]\s*\(\(T_医療費\.除外\)=[A-Za-z]+\sOr\s\(T_医療費\.除外\)=[A-Za-z]+\)\);"
     ' MsgBox myStr1 ' debug
     ' 置換後のパターン(v2)
     v2 = "HAVING (((Format([日付],""yyyy/mm""))>=" & YYYY1 & "/" & MM1 & "And (Format([日付],""yyyy/mm""))<" & YYYY2 & "/" & MM2 & ")"
     v2 = v2 & " AND ((T_医療費.除外)=" & myJogai1 & " Or (T_医療費.除外)=" & myJogai2 & "));"
  End Select
  With reg
    .pattern = MyStr1 'パターンを設定
    .IgnoreCase = True '大文字と小文字を区別するFalseか、しないTrueか
    .Global = True '文字列全体を検索するTrueか、しないFalseか
    rep = .Replace(strSQL, v2) ' 置換
  End With
  ' クエリのSQL文を変更
  qdf.SQL = rep
  ' 解放
  Set qdf = Nothing
  Set dbs = Nothing
  If Application.SysCmd(acSysCmdGetObjectState, acQuery, myQuery1) <> 0 Then
    ' クエリが開いていたら、開きなおす
    DoCmd.Close acQuery, myQuery1, acSavePrompt
    DoCmd.OpenQuery myQuery1
  Else
    ' クエリが開いていなかったら、開く
    DoCmd.OpenQuery myQuery1
  End If
End Sub

たった、これだけのコードでも、月の切り替わりで問題が起きてしまうわけです。

新年号、早く発表してくれないんですかね。西暦年と年号(明治、大正、昭和、平成)の変換で問題が起きなければ、いいけど。

【参考記事】

アクセス小僧:VBAでクエリを変更(4)
https://cheese999.blog.so-net.ne.jp/2017-11-27-2

アクセス小僧:履歴を残す(4)
https://cheese999.blog.so-net.ne.jp/2018-11-16
ヤバイぜ!(15)  コメント(1) 
共通テーマ:パソコン・インターネット

ヤバイぜ! 15

コメント 1

cheese999

ヤバイぜ! ありがとうございます(^_0)ノ
by cheese999 (2018-12-09 05:37) 

コメントを書く

お名前:[必須]
URL:
コメント:
画像認証:
下の画像に表示されている文字(英大文字の「オー」、英小文字の「ユー」、アラビア数字の「ハチ」、アラビア数字の「イチ」、アラビア数字の「ニ」)を入力してください。

Facebook コメント