FRのりのブログ一覧

塾で使用する、小学校1年生～2年生のさんすうテストを作成するシステム（っていうほどのものでもないですが）を依頼されていました。

「期限は３月まででいいですから～」
といわれていたので今まで放置していたら、昨日突然
「できてますか？　ちょっと部長が見たいとおっしゃるもので」
と内線が・・（汗

ということで、あわてて作成開始・・・。

10問、20問のたし算のテストを自動作成するんですが、桁数の制限や答えの最大値の制限などがあり、以外と面倒・・・。

■設計メモ■
①まずはそれぞれの問題の合計の上限値が決まっているので、ＲＮＤ関数で乱数を発生させて、数字を足したときの合計数を決める。
②出た数を上限値として、数1をＲＮＤ関数にて再び出す。
③合計数から数1を引いて数2を出す。
④合計数と数１をキーにT_問題テーブルにすでに同じものが存在しないか検索する。
⑤一致するものがなければ、T_問題テーブルに問題番号、数1、数2、合計数を書き込む。
同じもものがあれば、②に戻って一致しない数が出るまで処理をくり返す。
⑥これを指定された問題数に達するまでくり返す。

仕上げに入っていたAccessのプログラムが、突然動かなくなりました（;´Д｀）

ファイルが壊れたのかと新しいMDBファイルを作成し、そこにテーブルもクエリもフォームもレポートも全部エクスポートしてみたけどコンパイルエラーが出る。

メインフォーム（ってこれしかないんだが）で起こるため、インポートしたフォームは削除して新規作成。

各ボタンにコードを貼り付けていったら、やっとコンパイルエラーを起こしているコードがわかりますた（汗

でもなんで、別々のコードなのに、一個がコンパイルエラー起こしたら全部動かなくなったんだろう？

不思議だ・・・（素人丸出しコメント）

コンパイルエラーを起こしてた理由は、宣言していない変数（単に書き間違えただけ）でした(つд∩) ｳｴｰﾝ

すぐ忘れるので、ここにMemo。

Private Sub cmd受付日報データ統合_Click()
'On Error GoTo Cmd_受付日報データ統合_error
Dim Dba1 As DATABASE, Dba2 As DATABASE
Dim Rs1 As Recordset, Rs2 As Recordset
Dim kRs1 As Recordset
Dim dHolder As String, tFail As String, kHolder As String
Dim kName As String
Dim Dba2Pass As String
Dim Rs2count As Long
Dim mySQL1 As String, mySQL2 As String, mySQL3 As String, mySQL4 As String, mySQL5 As String
Dim mySQL6 As String, mySQL7 As String
Dim i As Long
Dim MyCheck As Boolean


'データベース接続________________________________________________________________________________________
Set Dba1 = CurrentDb()

'SQL文の設定____________________________________________________________________________________________
mySQL1 = "SELECT データ格納フォルダ名, 統合ファイル名 FROM DEFOLT_KEY ;"
mySQL2 = "SELECT 教室番号, 統合フォルダ FROM M_KYOSHITUMEI WHERE 統合フォルダ <> NULL ;"

mySQL5 = "DELETE * FROM TMP_受付日報統合 ;"
mySQL6 = "DELETE * FROM TMP_前日累計_Spring ;"


'SQL文の実行____________________________________________________________________________________________
Set Rs1 = Dba1.OpenRecordset(mySQL1)

'受付日報データの格納フォルダとファイル名を取得____________________________________________________________
dHolder = Rs1!データ格納フォルダ名
tFail = Rs1!統合ファイル名
Debug.Print dHolder
'レコードのクリア
Rs1.Close
Set Rs1 = Nothing

'TMP_受付日報統合テーブルの全レコードの削除______________________________________________________________
Dba1.Execute mySQL5, dbFailOnError

'Rs2のレコード数をカウント_________________________________________________________________________________
Set Rs2 = Dba1.OpenRecordset(mySQL2) '統合フォルダ名が存在するかしないか
Rs2.MoveLast
Rs2count = Rs2.RecordCount 'Rs2count＝処理回数

Debug.Print Rs2count

'受付日報データ統合処理__________________________________________________________________________________
'レコードを検索するためにカレントを先頭に移す。
Rs2.MoveFirst

データ統合処理:
For i = Rs2count To 1 Step -1
kHolder = Rs2!統合フォルダ
kName = Rs2!教室番号
Debug.Print kHolder
Debug.Print kName
mySQL3 = "SELECT NIPPO_Spring.教室番号, NIPPO_Spring.受付日, NIPPO_Spring.春講_101, NIPPO_Spring.春講_102, NIPPO_Spring.春講_103, NIPPO_Spring.春講_104, NIPPO_Spring.春講_105, NIPPO_Spring.春講_106, NIPPO_Spring.春講_107, NIPPO_Spring.春講_108, NIPPO_Spring.春講_109, NIPPO_Spring.春講OP_109, NIPPO_Spring.OP_109, NIPPO_Spring.在籍OP_109, NIPPO_Spring.春講_301, NIPPO_Spring.春講_302, NIPPO_Spring.春講_303, NIPPO_Spring.春講_304, NIPPO_Spring.春講_305, NIPPO_Spring.春講_306, NIPPO_Spring.春講_307, NIPPO_Spring.春講_308, NIPPO_Spring.春講_309, NIPPO_Spring.春講_311, NIPPO_Spring.春講_312, NIPPO_Spring.春講_313, NIPPO_Spring.春講_403, NIPPO_Spring.春講_404, NIPPO_Spring.春講_405, NIPPO_Spring.春講_406 FROM NIPPO_Spring WHERE NIPPO_Spring.教室番号 = " & "'" & kName & "'" & " ;"
Debug.Print mySQL3
MyCheck = IsNull(kHolder) '統合フォルダ名の有無のチェック
If MyCheck = True Then
i = i + 1 '統合フォルダ名が存在しない場合、処理回数をプラス1する。
Else
Dba2Pass = dHolder & kHolder & "\" & tFail 'レコードを取得するテーブルが存在するファイルへのフルパス
Debug.Print Dba2Pass
Set Dba2 = OpenDatabase(Dba2Pass) '実行時エラー3044（ファイルが存在しない）が発生した場合、エラートラップあり
Set kRs1 = Dba2.OpenRecordset(mySQL3) 'レコードの検索

If kRs1.EOF = True And kRs1.BOF = True Then 'レコードが一つも存在しない場合の処理
'
Else
Debug.Print kRs1!教室番号, kRs1!受付日, kRs1!春講_101, kRs1!春講_102, kRs1!春講_103, kRs1!春講_104, kRs1!春講_105, kRs1!春講_106, kRs1!春講_107, kRs1!春講_108, kRs1!春講_109, kRs1!春講OP_109, kRs1!OP_109, kRs1!在籍OP_109, kRs1!春講_301, kRs1!春講_302, kRs1!春講_303, kRs1!春講_304, kRs1!春講_305, kRs1!春講_306, kRs1!春講_307, kRs1!春講_308, kRs1!春講_309, kRs1!春講_311, kRs1!春講_312, kRs1!春講_313, kRs1!春講_403, kRs1!春講_404, kRs1!春講_405, kRs1!春講_406

Do Until kRs1.EOF = True '最後のレコードまで処理をくり返す
mySQL4 = "INSERT INTO TMP_受付日報統合 (教室番号, 受付日, 春講_101, 春講_102, 春講_103, 春講_104, 春講_105, 春講_106, 春講_107, 春講_108, 春講_109, 春講OP_109, OP_109, 在籍OP_109, 春講_301, 春講_302, 春講_303, 春講_304, 春講_305, 春講_306, 春講_307, 春講_308, 春講_309, 春講_311, 春講_312, 春講_313, 春講_403, 春講_404, 春講_405, 春講_406)" _
& " VALUES(" & kRs1!教室番号 & ", " & kRs1!受付日 & ", " & kRs1!春講_101 & ", " & kRs1!春講_102 & ", " & kRs1!春講_103 & ", " & kRs1!春講_104 & ", " & kRs1!春講_105 & ", " & kRs1!春講_106 & ", " & kRs1!春講_107 & ", " & kRs1!春講_108 & ", " & kRs1!春講_109 & ", " & kRs1!春講OP_109 & ", " & kRs1!OP_109 & ", " & kRs1!在籍OP_109 & ", " & kRs1!春講_301 & ", " & kRs1!春講_302 & ", " & kRs1!春講_303 & ", " & kRs1!春講_304 & ", " & kRs1!春講_305 & ", " & kRs1!春講_306 & ", " & kRs1!春講_307 & ", " & kRs1!春講_308 & ", " & kRs1!春講_309 & ", " & kRs1!春講_311 & ", " & kRs1!春講_312 & ", " & kRs1!春講_313 & ", " & kRs1!春講_403 & ", " & kRs1!春講_404 & ", " & kRs1!春講_405 & ", " & kRs1!春講_406 & ");"
Debug.Print mySQL4
Dba1.Execute mySQL4, dbFailOnError '検索結果、レコードが存在する場合はTMP_受付日報統合にレコードの追加を実行
kRs1.MoveNext
Loop
End If
'値のクリア
kRs1.Close
Dba2.Close
Set Dba2 = Nothing
Set kRs1 = Nothing
kHolder = ""
kName = ""
End If
'次のレコードに移動する
Rs2.MoveNext
Next i '次の処理に移る

Cmd_受付日報データ統合_Exit:
Exit Sub

'Cmd_受付日報データ統合_error:
'If Err.Number = 3044 Then 'エラー3044発生時に次のレコードに移動させて処理を続行させる
' Rs2.MoveNext
' Resume データ統合処理
'End If

Debug.Print Err.Number
End Sub

今の会社に派遣として勤務して３ヶ月。

今までは前任者の方が残していった、すべてマクロで組まれたAccessプログラムを修正して使用してました。

私はマクロが逆によくわからない（爆）ので、途中にVBAで組んだプログラムを入れようとすると、マクロが邪魔をしてきて上手く動かないことも・・・（;´Д｀）

あと、無駄な動作が多い（他のAccessファイルからテーブルごとインポートしてきて、追加クエリでデータを別テーブルに移したあとインポートしたテーブルを削除、を三十数か所の支所分全部にやるとか）ので、全部VBAで組み直すことにしました。

支所の人が毎日の受付データを入力用のファイルに入力するのですが、今までの物だとその日に本当に入力したのかしてないのか、入力した本人しかわからない状態。

おかげで今日データ集計したところ、昨日のデータが未入力だった支所に電話して確認したら、「入力したっていってます（逆切れ）」までされました・・・（こっちはテーブルごと取り込んでるんだから、ないもんはないっちゅーの）

なので新しく作った入力用フォームには「お知らせ」欄を作ってあげました。
「○月○日のデータが未入力です」と表示してあげるようにしたので、これからは逆切れされることもないでしょう（ﾜﾗ