説明会の実施方法、出願手続きの問題、入試当日の運営など、これまでの方法では対応できなくなりました。連載予定であったシステムは旧来の方法に沿った内容なので、今更連載を継続してもほとんど役をしないと思われます。

新たなシステム運用に関して、まとめることができた時点で再掲載をする予定です。

さて、私立高校の特殊な事情とは何かというと、「進路相談」というものです。名称はいろいいろあるかもしれませんが、地域的なこともありますので詳しいことはここでは言及しないでおきます。学校関係者であればお分かりのことと思います。

今回紹介するシステムは、
「進路相談」→「入試関係事務」→「教務事務システム」
の一連の流れを踏まえた入試システムであることが前提です。

次回以降の連載で詳細を紹介しますが、他の連載同様、Accessのシステムとなります。VBAの基本も理解されていることが必要です。

最後に、運用面ですが起動時にフォームF_1を表示するようにすること。リボンを非表示にすること。ナビゲーションを非表示にすること。 accdeファイルに変換しておく。

など、担当者が不要な操作をできないようにすればトラブルを回避できます。

レコードソースとなるクエリQ_Fは以下の通りです。

SELECT T_kubun.校舎区分, T_kubun.担当区域, T_kubun.担当者, T_tenken.T_fubi, T_tenken.T_date, T_tenken.T_soti
FROM T_kubun INNER JOIN T_tenken ON T_kubun.id = T_tenken.S_id
WHERE (((T_tenken.T_fubi)<>"不備なし") AND ((T_tenken.T_date)=[forms]![F_1]![td]));

処理件数は
rcc = DCount(“*”, “Q_F”) で取得。TextBoxに表示
現在の処理件数は
Me.CurrentRecordで取得。TextBoxに表示

以下、各ボタンの処理内容を列記します。
エラー処理等は割愛します。

Private Sub 先頭_Click()

    Me.次へ.Enabled = True
    Me.前へ.Enabled = False
    DoCmd.GoToRecord , , acFirst

End Sub

Private Sub 前へ_Click()

If Me.CurrentRecord > 1 Then
    Me.前へ.Enabled = True
    Me.次へ.Enabled = True
    DoCmd.RunCommand acCmdSaveRecord
End If

    DoCmd.GoToRecord , , acPrevious

If Me.CurrentRecord = 1 Then
    Me.前へ.Enabled = False
    Me.次へ.Enabled = True
    DoCmd.RunCommand acCmdSaveRecord
End If
    
End Sub

Private Sub 保存_Click()

    DoCmd.RunCommand acCmdSaveRecord

End Sub

Private Sub 次へ_Click()
   Me.前へ.Enabled = True

If Me.CurrentRecord < rcc Then
   Me.次へ.Enabled = True
End If

   DoCmd.GoToRecord , , acNext

If Me.CurrentRecord = Me.rc Then
    Me.保存.SetFocus
    Me.次へ.Enabled = False
    DoCmd.RunCommand acCmdSaveRecord
End If

End Sub

Private Sub 最終_Click()

    Me.前へ.Enabled = True
    Me.次へ.Enabled = False
    
    DoCmd.GoToRecord , , acLast

End Sub

ところで、 Accessの基本機能では、レコードセレクタがあり件数が表示されますが、一般のエンドユーザーには理解できません。鉛筆マークの意味も分かるはずがありません。
ましてやレコードの保存タイミングなど分かるはずがありません。
多くの書籍がAccessの基本機能を理解していることを前提にいろいろ説明していますが、それは無理です。
初めて触れるユーザーには分からないでしょう。
従って、上のような画面設計とし、レコードが移動した時点で保存されるのですが、それは初心者には分かりません。
おそらくレコードが移動した時点で、「入力した内容が消えてしまった」と思うに違いありません。
そうしたことに配慮しないといけません。
初心者にも(誰でも)分かるように、保存ボタンを加えました。
これで、入力した内容がしっかり保存できたと安心してもらうためです。
前にもふれた通り、職場の職務上の管理者といえどもPCの専門家ではありません。
システム運用にはそれなりの配慮が必要なのです。
コードは次回としますが、特別な難しい内容はありません。

かなり細かい表組なので、Accessのレポートデザイン画面の
描画機能だけで行うのは大変です。
従って、今回もワードで作成した表をOLEオブジェクトとし埋め込んで対応します。
位置調整などは微妙なので、何回も印刷して仕上げる必要があります。

連載途中ですが先に公開します。
Access版と同様の機能を持たせました。

利用する関数はAccess版と同じです。
ただし、タイマーイベントは使えないので
Timer()関数で経過時間を判定します。
画面例とコードは以下の通りです。

Dim dt As Date
Dim stf As Integer  'stop用フラグ

Private Sub CommandButton1_Click()
 stf = 0
 Call my_Procedure

End Sub

Private Sub CommandButton2_Click()
'Resetボタンで初期化
 dt = TimeSerial(Range("A1"), Range("B1"), Range("C1"))
 Me.TextBox1 = dt

End Sub

Private Sub CommandButton3_Click()
stf = 1
End Sub

Private Sub Label2_Click()

End Sub

Private Sub UserForm_Initialize()
'初期化
 dt = TimeSerial(Range("A1"), Range("B1"), Range("C1"))
 Me.TextBox1 = dt
 Me.Label2.Caption = dt

End Sub

Public Sub my_Procedure()
  Dim t_start As Double
  Dim t_next As Double
  Dim t_timer As Double

  t_start = Timer()
  t_next = t_start
  
  Do
   If t_next - t_start > Range("A1") * 3600 + Range("B1") * 60 + Range("C1") Then Exit Do
   If stf = 1 Then Exit Do  'stopボタンが押されたかどうか

   t_timer = Timer() - t_next
    If t_timer > 1 Then
       t_next = Timer()
       dt = DateAdd("s", "-1", dt)
       Me.TextBox1 = dt
       Range("A4") = dt
   End If
   DoEvents
  Loop

End Sub

Private Sub com1_AfterUpdate()

'学習モードによって異なる処理を書く。
'タイマーの設定が必要な場合の処理を書く。

'ステージ画面の初期化
    Call all_v_false
    Call all_t_null
    
'ステージ毎の問題文
Me.Txt2 = str1Data(Me.com1 - 1)

'改行があると画像指定が複雑となるので取り除く(一時的テキスト)
tmptxt = Replace(Me.Txt2, vbCrLf, "")

'問題文の長さ
mlen = Len(Me.Txt2)

'指定画像の位置取得
imglen = InStr(tmptxt, "jpg")
    
'画像があるかないか
If imglen > 0 Then     '画像あり
    
        Me.Timg = upath & Left(tmptxt, imglen + 2) '改行ないのでLeftでok
        imgst = InStr(Me.Txt2, "jpg") '改行を含めた位置(問題文用)
        Me.objImg.Picture = Me.Timg
        
Else                    '画像なし
        
   Me.objImg.Picture = ""

End If

'as aeの位置
    aslen = InStr(Me.Txt2, "as")
    aelen = InStr(Me.Txt2, "ae")

'選択肢文字列
If aslen > 0 Then
     strsentakusi = Replace((Mid(Me.Txt2, aslen + 3, (aelen - aslen - 3))), vbCrLf, "")
End If
    
    
'選択肢の抽出及び数の取得
str2Data = Split(strsentakusi, ",")
Me.Tans = UBound(str2Data) + 1

'問題数取得(問題文asのあとの1文字がその数値)
mondaisu = Val(Mid(Me.Txt2, aslen + 2, 1))

'問題数に合わせた選択肢、解答欄の準備処理の呼び出し
Call set_mon

'正解を格納する
'正解は、シャッフルする前の選択肢の先頭から問題数の分だけの文字列
    For m = 1 To mondaisu
        seikai(m) = str2Data(m - 1)
    Next

'選択肢をシャッフルする
    For i = UBound(str2Data) To 1 Step -1
        P = Int((i + 1) * Rnd)
        buf = str2Data(P)
        str2Data(P) = str2Data(i)
        str2Data(i) = buf
    Next
    
Me.Tmon = Mid(Me.Txt2, aslen + 2, 1)  '変数mondaisuと同じ

'最終問題文
    If aslen > 0 And imgst > 0 Then '画像あり問題文

        Me.Txt3 = Mid(Me.Txt2, imgst + 3, aslen - imgst - 4)
        
    ElseIf aslen = 0 And imgst > 0 Then   '画像あり説明文

        Me.Txt3 = Mid(Me.Txt2, imgst + 3)
        
    ElseIf aslen > 0 And imgst = 0 Then    '画像なし問題文

    Me.Txt3 = Mid(Me.Txt2, 1, aslen - 1)
    
    Else

     Me.Txt3 = Me.Txt2      '画像なし説明文

    End If
    
'選択肢の表示
    For j = 1 To Me.Tans

        Me.Controls("Tsentakusi" & j) = str2Data(j - 1)
        Me.Controls("Tsentakusi" & j).Visible = True
        Me.Controls("Tsentakusi" & j).Enabled = True

    Next

End Sub

次回以降、学習者が解答したときの処理や正誤判定の処理へと進みます。

1.については、前回のコードでは省略しましたが問題文を読み込んだ時点で、
テキストシナリオ「終」でsplit(分割)して配列変数に入れます。
それによって配列のインデックス最大値がわかるので、問題のステージ数もコンボにボックスに設定できます。
実際にはそこまでを読込処理とします。
配列のインデックスは0から始まるので各ステージの問題文を読み込むのは(ステージ数-1)の配列インデックスになります。
この数値をもとに、コンボボックスの更新後イベントに
2.～7.までの処理を書きます。

前回のコードの最後に、1.の部分を追加しておきます。

Private Sub 問題読込_Click()

‘前回のコードの後に追加

Me.Txt1 = strData
str1Data = Split(strData, “終”)
Me.Tstage = UBound(str1Data) + 1
‘ステージ数をcom1にセット
For i = 1 To Me.Tstage
com1.AddItem i
Next

End Sub

2.以下の処理は次回以降とします。

Private Sub 問題読込_Click()
'### 問題テキストファイルを読み込み###
'### テキストボックスに入れる処理 ###
'
'ヘルプを参考に書き換えれば仕上がります
'
'ダイアログを開きファイルを選択します。
'
' Requires reference to Microsoft Office 11.0 Object Library.
Dim fDialog As Office.FileDialog
Dim varFile As Variant
' Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogOpen)
With fDialog
' Allow user to make multiple selections in dialog box
' Set the title of the dialog box. .
Title = "問題文を選択してください"
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "問題ファイル", "*.txt"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
'Loop through each file selected and add it to our list box.
varFile = .SelectedItems.Item(1)
End If
End With
'ここから読込処理開始
Open varFile For Input As #1
Do While Not EOF(1)
Line Input #1, textline
strData = strData & textline & vbCrLf
Loop
Close #1
'確認のためテキストボックスに表示する
Me.Txt1 = strData
'ここからは一気に読み込む方法です
' Dim tmpStr As String
' Open GetFileName For Binary As #1
' tmpStr = Space(LOF(1))
' Get #1, , tmpStr
' tmpStr = Replace(tmpStr, vbNullChar, "")
' Close #1 ' Me.Txt1 = tmpStr
'一気に読み込む方法はここまで
'この後は問題文を表示するための文字列操作処理がいろいろ続く
'それは次回以降に掲載予定
End Sub