FC2ブログ

スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

どの方法が良いのだろう 


あるQAで、以下の条件があったとして、フォームを作るには・・・

テーブル「Tチーム」
フィールド型 等々
 チームID オートナンバ (主キー)
 チーム名 テキスト

テーブル「T試合」
フィールド型 等々
 試合ID オートナンバ (主キー)
 試合日 日付/時刻
 天候 テキスト
 相手チーム 長整数 「Tチーム」のチームID
 試合場所 テキスト

テーブル「T選手」
フィールド型 等々
 選手ID オートナンバ (主キー)
 選手名 テキスト
 よみ テキスト

テーブル「T出場」
フィールド型 等々
 an オートナンバ (主キー)
 試合ID 長整数 「T試合」の試合ID
 選手ID 長整数 「T選手」の選手ID

つまり、自チームの選手「T選手」が、どの対戦相手の時に出場していたか・・・・

フォームのイメージとしては、
・「T試合」を登録/修正時に、
・「T選手」の全選手を表示して(100くらい)
  チェックボックス形式で入力操作したい。(「T出場」を同時に作りこみたい)

ザッと考えてみたフォームは9つ
1)帳票フォームに帳票サブフォーム(F1M/F1S)
  kEnt128_F1  kEnt128_F1D
2)単票に2つの帳票サブフォーム(F2M/F2S1/F2S2)
  kEnt128_F2  kEnt128_F2D
3)単票に10個のサブフォーム(F3M/F3S)(あ行、か行・・・毎にサブフォーム)
  kEnt128_F3  kEnt128_F3D
4)単票に6個のサブフォーム(F4M/F4S)(1つのサブフォームでは20人表示)
  kEnt128_F4  kEnt128_F4D
5)上記フォームのワークテーブル使用バージョン(F5M/F5S)
  kEnt128_F5  kEnt128_F5D
6)単票に多数の非連結チェックボックス(F6M)
  kEnt128_F6  kEnt128_F6D
  上記フォームのVBA記述量削減・操作限定バージョン(F6M2)
  kEnt128_F62  kEnt128_F62D
7)上記フォームの表示変更バージョン(F7M)
  kEnt128_F7
8)単票にタブコントロール配置(F8M)(タブページで、あ行、か行・・・)
  実際に操作するのは、多数の非連結チェックボックス
  kEnt128_F8  kEnt128_F8D  kEnt128_F8_2000
9)単票に単票サブフォーム(F9M/F9S) (ワークテーブル使用)
  kEnt128_F9  kEnt128_F9D

で、6)を回答。

回答からブログの記事にするまで、いろいろ勉強させられました。
2007 で作成して、2003 / 2000 形式に変換して確認しているわけですが・・・
これに手間取っていました。

※ 2000 には、Form_Undo がない

※ サブフォームで組み込んだフォームの Form_Open / Form_Load は、
  2000 の場合は連続して実行されない時がある。
  特に分ける必要がない場合には、Form_Open 1つに記述した方が無難

※ サブフォームコントロールで、SourceObject にフォームを設定したタイミングで
  LinkMasterFields / LinkChildFields が自動設定される時がある。

私が知らなかっただけなのかも・・・・
今回の記事はチョッくら長いです。
 
テーブル「T選手」内の「よみ」は、必ず設定されているものとして記述していきます。
また、「T試合」を表示しているフォームでは、削除操作がないものとしてします。
なので、フォームでの「削除の許可」は「いいえ」としておきます。

これは、「T試合」のレコードを削除した際、「T出場」のレコードをどういう方法で削除するか・・・
自力で?
使った事ないけど、リレーションシップで「連鎖削除」を設定しておく?
今回、削除については触れないという事で・・・・


1)帳票フォームに帳票サブフォーム(F1M/F1S)
  kEnt128_F1  kEnt128_F1D
メインのフォーム「F1M」は「T試合」を元にフォームウィザードで「試合ID」以外を表示するように。
「試合ID」はオートナンバなので、表示はいらないでしょう・・・という事で。
サブフォームがフォームのイベントを取得できるように、プロパティ「コード保持」を「はい」に。

サブフォームになる「F1S」は、フォームデザインで作っていきます。
レコードソースを SELECT T選手.選手ID, T選手.選手名, T選手.よみ FROM T選手 ORDER BY T選手.よみ;
ヘッダ部分に非表示のテキストボックス「txt1」
これの用途は、親で選ばれた試合に出場した選手の「選手ID」が「,」(カンマ)区切りで・・・
詳細部分には、
・チェックボックス「ck」
 このチェックボックスでは、コントロールソースを使用しますがVBAで設定するので、そのままに。
 ラベル部分はいらないので削除
 タブストップは「いいえ」
・そのチェックボックスを覆う形で(前面側に)、コマンドボタン「btn1」
 背景スタイルを透明
 このボタンがクリックされた=チェックボックスの チェック 切り換えと解釈
 タブ移動順を先頭に
・選手名用テキストボックス「選手名」
 ラベル部分はいらないので削除
 コントロールソースを 選手名 に設定
 念のため、タブストップを「いいえ」
 このテキストボックスは、チェックボックスにくっ付いているラベルの様な動きにします。
 チェックボックスにチェックが入っていたら、背景色を変更します。
 この変更に、条件付き書式を使いますが、VBAで設定するので、そのままに。

フォームは帳票フォームにして、
・レコードセレクタ「いいえ」
・移動ボタン「いいえ」
・スクロール「垂直のみ」
・追加/削除/更新の許可は、すべて「いいえ」

フォームのデザインはこれで終わりです。

見栄え上のことですが、チェックボックスが多数並ぶのでチェックだけでは分かりづらい???
ということで、チェックしたら選手名のところの背景色を変更しましょう・・・という事にしました。

VBAを記述していくわけですが、処理概要をまず。

親で「試合ID」が変化したら「T出場」から、その試合に出ていた「選手ID」を求めます。
この【親で「試合ID」が変化したら】は、親のレコード移動時を検知するようにします。
その求まった「選手ID」を「,」(カンマ)区切りで羅列したものを「txt1」に設定します。
チェックボックスでは、その設定された「txt1」内に、自レコードの「選手ID」があるか判別表示します。
チェックボックスのコントロールソース記述で
 =IIF(InStr([txt1],"," & [選手ID] & ",")>0,True,False)
これと同じような判別で、テキストボックス「選手名」の背景色を条件付き書式で変更します。
式が、InStr([txt1],"," & [選手ID] & ",")>0  で、背景色を RGB(255, 240, 240)

チェックボックスがクリック(実際にはコマンドボタン「btn1」のクリック)されたら、
「txt1」に自レコードの「選手ID」があれば、その部分を削除、なければ新たに追加・・・
本来、文字列の操作ですが、面倒だったので Dictionary で選手IDを管理することに。
この変更のタイミングで、「T出場」のレコードを操作することに。

また、テキストボックス「選手名」にフォーカス移動(実際にはマウスのクリック)された場合は、
フォーカスを「btn1」に移し、「btn1」がクリックされた時の処理を・・・・
これにより、テキストボックス「選手名」はチェックボックス「ck」のラベル的動きに・・・・???

記述したのは以下
Private Const EVENT_PROCEDURE As String = "[EVENT PROCEDURE]"
Dim WithEvents frm As Form

Dim dic As Object

Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  Set frm = Me.Parent
  If (frm Is Nothing) Then
    Cancel = True
    Exit Sub
  End If

  Set dic = CreateObject("Scripting.Dictionary")
  frm.OnCurrent = EVENT_PROCEDURE
  Me.ck.ControlSource = _
    "=IIF(InStr([txt1],"","" & [選手ID] & "","")>0,True,False)"
  With Me.選手名.FormatConditions
    .Delete
    With .Add(acExpression, , "InStr([txt1],"","" & [選手ID] & "","")>0")
      .BackColor = RGB(255, 240, 240)
    End With
  End With
End Sub

Private Sub Txt1ValueSet()
  If (dic.Count > 0) Then
    Me.txt1 = "," & Join(dic.Keys, ",") & ","
  Else
    Me.txt1 = ",,"
  End If
End Sub

Private Sub frm_Current()
  Dim sSql As String
  Dim rs As DAO.Recordset

  dic.RemoveAll

  If (Not IsNull(frm.試合ID)) Then
    sSql = "SELECT * FROM T出場 WHERE 試合ID = " & frm.試合ID & ";"
    Set rs = CurrentDb.OpenRecordset(sSql)
    While (Not rs.EOF)
      dic.Item(rs("選手ID").Value) = Null
      rs.MoveNext
    Wend
    rs.Close
    Set rs = Nothing
  End If
  Call Txt1ValueSet
End Sub

Private Sub btn1_Click()
  Dim sSql As String
  Dim i As Long

  If (IsNull(frm.試合ID)) Then Exit Sub

  i = Me.選手ID
  If (dic.Exists(i)) Then
    sSql = "DELETE * FROM T出場 WHERE 試合ID = " _
        & frm.試合ID & " AND 選手ID = " & i & ";"
    CurrentDb.Execute sSql
    dic.Remove i
  Else
    sSql = "INSERT INTO T出場(試合ID, 選手ID) VALUES (" _
        & frm.試合ID & "," & i & ");"
    CurrentDb.Execute sSql
    dic.Item(i) = Null
  End If
  Call Txt1ValueSet
End Sub

Private Sub 選手名_Enter()
  Me.btn1.SetFocus
  btn1_Click
End Sub

Private Sub Form_Close()
  Set frm = Nothing
  Set dic = Nothing
End Sub

で、出来上がった「F1S」を「F1M」のフッタ部分にドラッグ&ドロップします。
この時、「F1M」は単票に変更されますが、再度帳票に変更して終了。
(このメイン/サブ構成は自己責任で・・・・)

この処理で、親の更新後処理で表示し直す必要があるのでは・・・・・については、
更新後処理で「試合ID」が変化するケースは、新規登録された場合だけになるので、
元々その試合には出場している選手は存在しないので、取得し直すことは不要になります。
(親が新規行にレコード移動した際に Dictionary はクリアされているので)
(以降のフォームでは、親の更新後処理を検知するものもあります)

その他の部分で、疑問を持たれる方がいるかも・・・・・ん、どの部分??
選手IDを Dictionary で管理しているのなら、チェックボックス、条件付き書式のところで
Dictionary にあるか・・・チェックすれば、非表示の「txt1」は不要なのでは・・・・・
これ用に上記を変更するとしたら以下の様になります。(変更する部分のみ)
Private Function DicChk(v As Variant) As Boolean
  DicChk = dic.Exists(v.Value)
End Function


Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  Set frm = Me.Parent
  If (frm Is Nothing) Then
    Cancel = True
    Exit Sub
  End If

  Set dic = CreateObject("Scripting.Dictionary")
  frm.OnCurrent = EVENT_PROCEDURE
  Me.ck.ControlSource = "=DicChk([選手ID])"
  With Me.選手名.FormatConditions
    .Delete
    With .Add(acExpression, , "DicChk([選手ID])")
      .BackColor = RGB(255, 240, 240)
    End With
  End With
End Sub

Private Sub Txt1ValueSet()
  Me.Recalc
End Sub
これでも動作するんですが、変更したら毎回 Me.Recalc が必要になって、チラつきが大きくなるんですね。
Me.Recalc しないと、初期表示のまま何も変化がありません。
コントロールソースや条件付き書式の式で指定したものに変更がないと、変化しないようです。
なので、その指定した部分([txt1]が変更された・・・)を使うようにしてました。
でも、チラつきについては同じなのかなぁ・・・・雰囲気は違うみたいなんだけどなぁ・・・・

Private Sub Txt1ValueSet()
  Me.Painting = False
  Me.Recalc
  Me.Painting = True
End Sub
と、Painting で挟んだらチョッと改善されたけど・・・・

あと、記述に不満というか・・・・ Sub の関数を呼ぶ時、私は Call を付けて記述しています。
以下の部分には Call が付いているものと思ってください。(記述漏れでした)
Private Sub 選手名_Enter()
  Me.btn1.SetFocus
  Call btn1_Click
End Sub


2)単票に2つの帳票サブフォーム(F2M/F2S1/F2S2)
  kEnt128_F2  kEnt128_F2D
このフォームでは、帳票+帳票のメイン/サブフォーム構成ではなく、一般的に使える構成になると思います。
大元の非連結の単票フォーム(F2M)に、
サブフォームコントロール「FSUB1」として「T試合」用の帳票サブフォーム(F2S1)、
サブフォームコントロール「FSUB2」として「T選手」用の帳票サブフォーム(F2S2)を配置します。

フォーム「F2S2」は、前のフォーム「F1S」をコピーして中の記述をチョッとだけいじります。
(フォーム「F2S1」と連動するように)
フォーム「F2S1」は新しく「T試合」を元にフォームウィザードを使って、まず、単票として作成し、
(フィールドを縦に並べたかっただけ)それを帳票フォームに変更します。
削除は処理対象にしないので、削除の許可は「いいえ」に、「コード保持」は「はい」に。
親フォーム「F2M」は Form_Load 時、サブフォーム「F2S1」の情報を「F2S2」へ通知するだけ。
タイミング的には、親が Load された時点で、サブフォーム側の初期処理は終わっているようなので・・・
(「F2S2」単独で「F2S1」情報を取ろうとした時、「F2S1」が居なかったりする???)
「F2S2」では親からもらった「F2S1」情報を元に、「F2S1」のレコード移動時イベントを検知するように・・・
親では、「F2S2」の設定が終わったら、「F2S1」を Requery してレコード移動時イベントを作ってやる。

親フォーム「F2M」に記述したのは
Private Sub Form_Load()
  With Me.FSUB1
    Call Me.FSUB2.Form.frm_Set(.Form)
    .Form.Requery
  End With
End Sub

 
フォーム「F2S1」にはVBA記述なし。単独で起動されても問題ないかなぁ・・・
フォーム「F2S2」は「F1S」をコピーしたものだったので、変更した箇所を以下に
(「F1S」の Form_Open 部分を 2つの関数に分けただけです)
Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  If (Me.Parent.Name = "") Then
    Cancel = True
    Exit Sub
  End If

  Set dic = CreateObject("Scripting.Dictionary")
End Sub

Public Sub frm_Set(fm As Form)
  Set frm = fm
  frm.OnCurrent = EVENT_PROCEDURE
  Me.ck.ControlSource = _
    "=IIF(InStr([txt1],"","" & [選手ID] & "","")>0,True,False)"
  With Me.選手名.FormatConditions
    .Delete
    With .Add(acExpression, , "InStr([txt1],"","" & [選手ID] & "","")>0")
      .BackColor = RGB(255, 240, 240)
    End With
  End With
End Sub

サブフォームとして組み込まれていなければ、起動しない様に
親からフォーム「F2S1」(「T試合」を表示している帳票フォーム)のフォームを教えてもらう。
で、レコード移動時を検知できるように・・・・


3)単票に10個のサブフォーム(F3M/F3S)(あ行、か行・・・毎にサブフォーム)
  kEnt128_F3  kEnt128_F3D
このフォームでは、あ行、か行・・・別で表示しましょう・・・・というもの。

フォーム「F1M」を「F3M」としてコピーし、フッタ部分のサブフォームコントロールを削除。
フッタ部分の領域をなしにして、詳細部分を広げます。
その詳細部分にサブフォームコントロール「FSUB0」~「FSUB9」の10個配置します。
このサブフォームコントロールに、前作ったフォーム「F1S」を入れて、行別表示に仕立て上げます。
処理を少し変更するので、「F1S」を「F3S」としてコピーします。
サブフォームコントロールのソースオブジェクトは空欄にしておきます。
これは1つのフォーム「F3S」を使い回しする為の1つの方法だと思っています。
FSUB0 では「あ行」を表示して・・・・ FSUB1 では「か行」を表示して・・・・って指示したかったので
この指示に、親フォームのタグを連絡用に使い、ソースオブジェクトに「F3S」を設定
「F3S」では、情報を親のタグから入手し、指示に従った表示をするように。
サブフォームコントロールは、10人分を表示できる高さにデザインで設定しておきます。

親フォーム「F3M」に記述したのは以下
Private Const sFilter As String = _
      "[あ-お]*,[か-ご]*,[さ-ぞ]*,[た-ど]*,[な-の]*," _
      & "[は-ぽ]*,[ま-も]*,[や-よ]*,[ら-ろ]*,[わ-ん]*"

Private Sub Form_Load()
  Dim sAry() As String
  Dim i As Long

  sAry = Split(sFilter, ",")
  For i = 0 To UBound(sAry)
    Me.Tag = sAry(i)
    Me("FSUB" & i).SourceObject = "F3S"
  Next
End Sub

 
子フォーム「F3S」として「F1S」から変更した部分は以下
Private Const sSource As String = "SELECT * FROM T選手 WHERE よみ Like '%1' ORDER BY よみ;"
Private Const EVENT_PROCEDURE As String = "[EVENT PROCEDURE]"
Dim WithEvents frm As Form
Dim sFilter As String

Dim dic As Object

Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  Set frm = Me.Parent
  If (frm Is Nothing) Then
    Cancel = True
    Exit Sub
  End If

  Set dic = CreateObject("Scripting.Dictionary")
  frm.OnCurrent = EVENT_PROCEDURE
  sFilter = frm.Tag
  Me.RecordSource = Replace(sSource, "%1", sFilter)
  If (Me.Recordset.RecordCount <= 10) Then Me.ScrollBars = 0

  Me.ck.ControlSource = _
    "=IIF(InStr([txt1],"","" & [選手ID] & "","")>0,True,False)"
  With Me.選手名.FormatConditions
    .Delete
    With .Add(acExpression, , "InStr([txt1],"","" & [選手ID] & "","")>0")
      .BackColor = RGB(255, 240, 240)
    End With
  End With
End Sub

Private Sub frm_Current()
  Dim sSql As String
  Dim rs As DAO.Recordset

  dic.RemoveAll

  If (Not IsNull(frm.試合ID)) Then
    sSql = "SELECT * FROM T出場 WHERE 試合ID = " & frm.試合ID _
        & " AND 選手ID IN (SELECT 選手ID FROM T選手 WHERE よみ LIKE '" _
        & sFilter & "');"

    Set rs = CurrentDb.OpenRecordset(sSql)
    While (Not rs.EOF)
      dic.Item(rs("選手ID").Value) = Null
      rs.MoveNext
    Wend
    rs.Close
    Set rs = Nothing
  End If
  Call Txt1ValueSet
End Sub

 
  If (Me.Recordset.RecordCount <= 10) Then Me.ScrollBars = 0
この記述ですが、表示選手が10人に満たない場合、2007 ではスクロールバー表示はありませんでした。
でも、2000 / 2003 では、常に縦のスクロールバーが表示される。
サブフォームコントロール側では10人分表示できるように設定しているので、
共通の処理として、表示対象が10人以下ならスクロールバーを表示しない様に・・・・

表示を見てみましたが、何のための空白部分か・・・何か違和感ありありです。
あ行、か行 の表示はやめて、20人単位で表示しましょうか・・・・っていうのが次(F4M/F4S)に


4)単票に6個のサブフォーム(F4M/F4S)(1つのサブフォームでは20人表示)
  kEnt128_F4  kEnt128_F4D
このフォームでは、20人単位でサブフォームとして表示しましょう・・・というもの

基本的な考え方/処理は前の(F3M/F3S)と同じなので、「F3M」を「F4M」、「F3S」を「F4S」にコピー
前のフォームでは、 よみ Like '%1'  の %1 にあたる文字列を指定していましたが、
今回のフォームでは 選手ID IN (%1)  の %1 にあたる文字列を指定するようにします。

フォーム「F4M」で、サブフォームコントロールを「FSUB1」~「FSUB6」の6つに
選手20人を表示できるようにしておきます。
処理の概要としては、選手を「よみ」順で20人単位でサブフォームを設定していきますが、
最後の「FSUB6」だけは20人を超えても作り続けるようにします。
その時に、もしかして・・・人数が多すぎて・・・・・タグの文字数制限に引っ掛かるようになるかも・・・
(その時にはその時で別の手段を使うように変更しますか・・・・)

親フォーム「F4M」に記述したのは以下
Private Sub Form_Load()
  Dim sSql As String
  Dim rs As DAO.Recordset
  Dim i As Long
  Dim iFSUB As Long

  sSql = "SELECT * FROM T選手 ORDER BY よみ;"
  Set rs = CurrentDb.OpenRecordset(sSql)
  iFSUB = 0
  i = 0
  sSql = ""
  While (Not rs.EOF)
    sSql = sSql & "," & rs("選手ID")
    i = i + 1
    If (i >= 20) Then
      If (iFSUB < 5) Then
        iFSUB = iFSUB + 1
        Me.Tag = Mid(sSql, 2)
        Me("FSUB" & iFSUB).SourceObject = "F4S"
        sSql = ""
      End If
      i = 0
    End If
    rs.MoveNext
  Wend
  rs.Close
  Set rs = Nothing
  If (Len(sSql) > 0) Then
    Me.Tag = Mid(sSql, 2)
    Me("FSUB" & iFSUB + 1).SourceObject = "F4S"
  End If
End Sub

 
子フォーム「F4S」で「F3S」から変更した部分は以下
Private Const sSource As String = "SELECT * FROM T選手 WHERE 選手ID IN (%1) ORDER BY よみ;"
Private Const EVENT_PROCEDURE As String = "[EVENT PROCEDURE]"
Dim WithEvents frm As Form
Dim sFilter As String

Dim dic As Object

Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  Set frm = Me.Parent
  If (frm Is Nothing) Then
    Cancel = True
    Exit Sub
  End If

  Set dic = CreateObject("Scripting.Dictionary")
  frm.OnCurrent = EVENT_PROCEDURE
  sFilter = frm.Tag
  Me.RecordSource = Replace(sSource, "%1", sFilter)
  If (Me.Recordset.RecordCount <= 20) Then Me.ScrollBars = 0
  Me.ck.ControlSource = _
    "=IIF(InStr([txt1],"","" & [選手ID] & "","")>0,True,False)"
  With Me.選手名.FormatConditions
    .Delete
    With .Add(acExpression, , "InStr([txt1],"","" & [選手ID] & "","")>0")
      .BackColor = RGB(255, 240, 240)
    End With
  End With
End Sub

Private Sub frm_Current()
  Dim sSql As String
  Dim rs As DAO.Recordset

  dic.RemoveAll

  If (Not IsNull(frm.試合ID)) Then
    sSql = "SELECT * FROM T出場 WHERE 試合ID = " & frm.試合ID _
        & " AND 選手ID IN (" & sFilter & ");"

    Set rs = CurrentDb.OpenRecordset(sSql)
    While (Not rs.EOF)
      dic.Item(rs("選手ID").Value) = Null
      rs.MoveNext
    Wend
    rs.Close
    Set rs = Nothing
  End If
  Call Txt1ValueSet
End Sub

 

ここまでのフォームでは、帳票フォームで非連結のチェックボックスを使ってきました。
この方法からチョッと離れて考えてみよう・・・・ということで、以降、違う方法になっていきます。


5)上記フォームのワークテーブル使用バージョン(F5M/F5S)
  kEnt128_F5  kEnt128_F5D
前回のフォーム構成を使って、サブフォーム側のレコードソースをワークテーブルにしてみます。
テーブル「Tワーク出場5」として
フィールド型 等々
 an オートナンバ (主キー)
 試合ID 長整数 「T試合」の試合ID
 選手ID 長整数 「T選手」の選手ID
 ck  Yes/No型
を使ってみます。
1試合分のデータだけを扱うようにします。
試合ID は不要?なのかもしれません。
データを「Tワーク出場5」「T出場」間でやり取りしやすかったので・・・
(これが後で問題に・・・・・・・・・後述)

フォーム「F4M」を「F5M」としてコピーします。
サブフォームの個数、20人までの表示は前と変わりません。
変わるのは、ワークテーブル「Tワーク出場5」から本テーブル「T出場」へ戻すタイミングを作ること・・・・
更新用のボタン「btn1」と、
戻す(本テーブル「T出場」からワークテーブル「Tワーク出場5」へ再展開)用のボタン「btn2」を配置

サブフォーム用のフォームは「F4S」を「F5S」としてコピーします。
レコードソースは表示する際に書き換えるものの、
標準で「Tワーク出場5」と「T選手」とで選手名を表示できるようにしたものを設定しておきます。
ヘッダ部にあった「txt1」、詳細部分でチェックボックスを覆っていた「btn1」は削除します。
チェックボックス「ck」のコントロールソースに「ck」を設定し、タブストップを「はい」に。
チェックボックスをクリックして更新するので、フォームの「更新の許可」だけ「はい」に変更。

処理の概要を。

メインフォーム「F5M」では、Load 時、「Tワーク出場5」に全選手の選手IDを作成します。
「T選手」の「よみ」順で20人ずつサブフォームに割り当てていきます。
(「FSUB1」~順にソースオブジェクトにサブフォームを割り当てていきます)
レコード移動時に、「Tワーク出場5」の 試合ID と ck を更新します。
更新後処理では、新規で試合ID が割り当てられることがあるので、レコード移動時の処理をもう一度。
更新ボタン「btn1」がクリックされたら、「Tワーク出場5」を元にその試合に該当するものを作り直します。
戻すボタン「btn2」がクリックされたら、その試合にあったデータを「Tワーク出場5」に作り直します。

ここで、新規登録(試合IDがNull)の場合、「Tワーク出場5」の試合ID は 0 に設定。

サブフォーム側では、「Tワーク出場5」に対して「ck」を設定していきます。
設定する際、親に配置した更新ボタン「btn1」の文字色を変更するようにします。

親フォーム「F5M」に記述したのは以下
Private Sub Form_Load()
  Dim sSql As String
  Dim rs As DAO.Recordset
  Dim i As Long
  Dim iFSUB As Long

  sSql = "DELETE * FROM Tワーク出場5;"
  CurrentDb.Execute sSql
  sSql = "INSERT INTO Tワーク出場5(選手ID) " _
      & "SELECT 選手ID FROM T選手;"
  CurrentDb.Execute sSql

  sSql = "SELECT * FROM T選手 ORDER BY よみ;"
  Set rs = CurrentDb.OpenRecordset(sSql)
  iFSUB = 0
  i = 0
  sSql = ""
  While (Not rs.EOF)
    sSql = sSql & "," & rs("選手ID")
    i = i + 1
    If (i >= 20) Then
      If (iFSUB < 5) Then
        iFSUB = iFSUB + 1
        Me.Tag = Mid(sSql, 2)
        With Me("FSUB" & iFSUB)
          .SourceObject = "F5S"
          .LinkMasterFields = ""
          .LinkChildFields = ""
        End With
        sSql = ""
      End If
      i = 0
    End If
    rs.MoveNext
  Wend
  rs.Close
  Set rs = Nothing
  If (Len(sSql) > 0) Then
    Me.Tag = Mid(sSql, 2)
    With Me("FSUB" & iFSUB + 1)
      .SourceObject = "F5S"
      .LinkMasterFields = ""
      .LinkChildFields = ""
    End With
  End If
End Sub

Private Sub FSUBrequery()
  Dim i As Long

  For i = 1 To 6
    With Me("FSUB" & i)
      If (Len(.SourceObject) = 0) Then Exit For
      .Form.Requery
    End With
  Next
  Me.btn1.ForeColor = RGB(0, 0, 0)
End Sub

Private Sub Form_Current()
  Dim sSql As String

  sSql = "UPDATE Tワーク出場5 SET 試合ID = " & Nz(Me.試合ID, 0) _
      & ", ck = False;"
  CurrentDb.Execute sSql
  sSql = "UPDATE Tワーク出場5 INNER JOIN T出場 ON " _
      & "Tワーク出場5.試合ID = T出場.試合ID AND Tワーク出場5.選手ID = T出場.選手ID " _
      & "SET Tワーク出場5.ck = True;"
  CurrentDb.Execute sSql
  Call FSUBrequery
End Sub

Private Sub Form_AfterUpdate()
  Call Form_Current
End Sub

Private Sub btn1_Click()
  Dim sSql As String

  If (Me.btn1.ForeColor = RGB(0, 0, 0)) Then Exit Sub

  sSql = "DELETE * FROM T出場 WHERE 試合ID = " & Me.試合ID & ";"
  CurrentDb.Execute sSql
  sSql = "INSERT INTO T出場(試合ID, 選手ID) " _
      & "SELECT 試合ID, 選手ID FROM Tワーク出場5 WHERE ck = True;"
  CurrentDb.Execute sSql
  Call FSUBrequery
End Sub

Private Sub btn2_Click()
  Dim sSql As String

  If (Me.btn1.ForeColor = RGB(0, 0, 0)) Then Exit Sub

  sSql = "UPDATE Tワーク出場5 SET ck = False;"
  CurrentDb.Execute sSql
  sSql = "UPDATE Tワーク出場5 INNER JOIN T出場 ON " _
      & "Tワーク出場5.試合ID = T出場.試合ID AND Tワーク出場5.選手ID = T出場.選手ID " _
      & "SET Tワーク出場5.ck = True;"
  CurrentDb.Execute sSql
  Call FSUBrequery
End Sub

Private Sub Form_Close()
  Dim sSql As String

  sSql = "DELETE * FROM Tワーク出場5;"
  CurrentDb.Execute sSql
End Sub

 
子フォーム「F5S」に記述したのは以下
Private Const sSource As String = _
    "SELECT Q1.*, Q2.選手名 FROM Tワーク出場5 AS Q1 INNER JOIN T選手 AS Q2 " _
    & "ON Q1.選手ID = Q2.選手ID WHERE Q1.選手ID IN (%1) ORDER BY Q2.よみ;"
Dim frm As Form

Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  Set frm = Me.Parent
  If (frm Is Nothing) Then
    Cancel = True
    Exit Sub
  End If

  Me.RecordSource = Replace(sSource, "%1", frm.Tag)
  If (Me.Recordset.RecordCount <= 20) Then Me.ScrollBars = 0
  With Me.選手名.FormatConditions
    .Delete
    With .Add(acExpression, , "[ck]=True")
      .BackColor = RGB(255, 240, 240)
    End With
  End With
End Sub

Private Sub Form_Dirty(Cancel As Integer)
  If (Me.試合ID = 0) Then Cancel = True
End Sub

Private Sub ck_Click()
  frm.btn1.ForeColor = RGB(255, 0, 0)
End Sub

Private Sub 選手名_Enter()
  Me.ck.SetFocus
  If (Me.試合ID <> 0) Then
    Me.ck = Not Me.ck
    Call ck_Click
  End If
End Sub

Private Sub Form_Close()
  Set frm = Nothing
End Sub

 
上記で動いているようですが、この1つ前の記述では、
新規の試合を入力しようとした場合、サブフォーム部分に何も表示されない現象が発生。
1つ前の記述と言うと、サブフォームを設定する際の記述になりますが
(以下の黄色い部分の記述がありませんでした)
Private Sub Form_Load()
  Dim sSql As String
  Dim rs As DAO.Recordset
  Dim i As Long
  Dim iFSUB As Long

  sSql = "DELETE * FROM Tワーク出場5;"
  CurrentDb.Execute sSql
  sSql = "INSERT INTO Tワーク出場5(選手ID) " _
      & "SELECT 選手ID FROM T選手;"
  CurrentDb.Execute sSql

  sSql = "SELECT * FROM T選手 ORDER BY よみ;"
  Set rs = CurrentDb.OpenRecordset(sSql)
  iFSUB = 0
  i = 0
  sSql = ""
  While (Not rs.EOF)
    sSql = sSql & "," & rs("選手ID")
    i = i + 1
    If (i >= 20) Then
      If (iFSUB < 5) Then
        iFSUB = iFSUB + 1
        Me.Tag = Mid(sSql, 2)
        With Me("FSUB" & iFSUB)
          .SourceObject = "F5S"
          .LinkMasterFields = ""
          .LinkChildFields = ""

        End With
        sSql = ""
      End If
      i = 0
    End If
    rs.MoveNext
  Wend
  rs.Close
  Set rs = Nothing
  If (Len(sSql) > 0) Then
    Me.Tag = Mid(sSql, 2)
    With Me("FSUB" & iFSUB + 1)
      .SourceObject = "F5S"
      .LinkMasterFields = ""
      .LinkChildFields = ""

    End With
  End If
End Sub
 
      .SourceObject = "F5S"
でサブフォームの処理が走り始めるわけですが、
Form_Open が呼ばれる前に LinkMasterFields / LinkChildFields が "試合ID" に自動設定。
Form_Open の初めの処理で、LinkMasterFields / LinkChildFields をクリア(空文字設定)しても、
その後の、RecordSource 設定直後にまた、LinkMasterFields / LinkChildFields が "試合ID" に。
リレーションシップは設定していないし・・・・
ま、確かに、親の「試合ID」は主キーに設定していましたが・・・・
あ、ルックアップは設定していたかな・・・
Access さんのどこかのオプション設定で回避できるのかもしれないけど、その設定を強要する???
あれ、や・・・、名前の自動修正?? これってそのDBを限定できたっっっっっかも・・・(未確認)
でも、親側で SourceObject 設定後に、LinkMasterFields / LinkChildFields をクリアすれば
動くようなので、この記述を採用しました。

主キーと同じフィールド名があったから??・・・・次回から気をつけよう。


6)単票に多数の非連結チェックボックス(F6M)
  kEnt128_F6  kEnt128_F6D
これが回答に使った、そのものになります。

元にするフォーム「F6M_BASE」を作っておきます。(「T試合」を元にした単票フォーム)
「F5M」をコピーしてサブフォーム部分を削除、VBA記述を全削除したものにしておきます。
また、
・「登録」ボタンが押された時に登録する
・・・・ということが抜けていたので、それに対応するように、登録ボタン「btn1」を配置。

チェックボックスを作成していきますが、必要人数以上のチェックボックスを不可視で作っておいて、
表示する時に必要な分だけ、可視(Visible=True)に変更します。
チェックボックス名の命名規則として、「"ck" & 連番」とします。
(100くらい、ということだったので "ck1" ~ "ck120" )
手作業で多数のチェックボックスを作成して名前を変更・・・
これ面倒なので、VBAで作成します。

1列20個で、計120個(6列分)のチェックボックスと、それにひっつくラベル
このラベル部分に選手名を表示するようにします。

標準モジュール「M6Make」を用意しました。
チェックボックスを追加する対象のフォーム「F6M_BASE」を、一旦「F6M_BASE_」にコピーして、
作り終わったら「F6M」に名称を変更 という内容になってます。
Private Const sFname As String = "F6M_BASE"
Private Const sFnew As String = "F6M"
Private Const IPX As Long = 567
Private Const iRowCount As Long = 20
Public Const iM6Count As Long = 120

Public Sub M6MakeProc()
  Dim i As Long
  Dim sN As String, sNc As String
  Dim iRow As Long, iCol As Long

  On Error Resume Next
  sN = sFname & "_"
  DoCmd.DeleteObject acForm, sN
  DoCmd.CopyObject , sN, acForm, sFname
  DoCmd.OpenForm sN, acDesign
  With Forms(sN)
    iRow = IPX * 1
    iCol = IPX * 0.27
    For i = 0 To iM6Count - 1
      With CreateControl(sN, acCheckBox, acDetail)
        sNc = "ck" & i + 1
        .Name = sNc
        .Top = iRow + (i Mod iRowCount) * IPX * 0.5
        .Left = (i \ iRowCount) * IPX * 3.2 + iCol
        .Width = IPX * 0.4
        .Height = IPX * 0.4
        .DefaultValue = "0"
        .TabStop = False
        .Visible = False
      End With
      With CreateControl(sN, acLabel, acDetail, sNc)
        .Top = iRow + (i Mod iRowCount) * IPX * 0.5
        .Left = (i \ iRowCount) * IPX * 3.2 + (IPX * 0.42) + iCol
        .Width = IPX * 2.6
        .Height = IPX * 0.42
        .BorderStyle = 1
        .BorderWidth = 1
        .BorderColor = RGB(0, 0, 0)
        .BackStyle = 0
        .BackColor = RGB(255, 240, 240)
      End With
    Next
  End With
  DoCmd.Close acForm, sN, acSaveYes
  DoCmd.DeleteObject acForm, sFnew
  DoCmd.Rename sFnew, acForm, sN
End Sub

 
フォーム「F6M」にVBAを記述していきますが、概要をまず。

・チェックボックスクリック時
「T試合」の新規レコードであったら、見た目チェックを無効とするようにします
チェックボックスは非連結なので、変更してもレコード移動等のタイミングは分かりません。
なので、編集状態にしておくことで、レコード移動のタイミングを検知することが出来るようになります。
そこで、「天候」を同じ値で設定して編集状態に・・・
チェックボックスの変更状態を更新します。

・フォームが起動された時
「T選手」から選手情報をチェックボックスに割り当てていきます。
割り当てたチェックボックスのラベルに選手名を、+可視に
チェックボックスの Tag に、選手ID を登録しておきます。
これにより、クリックされた時、簡単に選手を特定できるようになります。

・レコード移動時
レコード移動によって「試合ID」が変化するので、その時の「試合ID」で
「T出場」にある選手を抽出し、チェックボックスを変更していきます。

・更新前
登録ボタン「btn1」クリックでのみ更新/登録できるようにするので、
意図しないタイミングでの更新はできない様に、常に Cancel = True とします

・取り消し時(2000では動かない)
チェックボックスを初期状態に戻し、レコード移動時に取得した選手情報でチェックボックスを再設定

・登録ボタン
「T試合」への登録チェックが必要であればこのタイミングで
一度、更新前処理を無効としてレコードを登録します。
「T出場」に対して、チェックボックスの状態を反映します。

dicOld は、レコード移動時に取得したその試合での選手情報で、
チェックボックスでの変更状況は dicNew にて。
レコード移動直後は、dicOld dicNew は同じ内容となっています。
チェックボックスの操作により、dicOld dicNew の差分で DELETE したり、INSERT したりします。
登録操作後、dicOld dicNew の内容を同じにするため、レコード移動時の処理を。

記述したVBAは以下
Dim dic As Object   ' どの選手にどのチェックボックスを割り当てたか
Dim dicOld As Object  ' 編集前の選手割り当て状況 (初期では dicOld = dicNew)
Dim dicNew As Object  ' いじっていた選手割り当て状況

Private Function ChkClick()
  If (IsNull(Me.試合ID)) Then
    Me.ActiveControl = Not Me.ActiveControl
    Exit Function
  End If

  Me.天候 = Me.天候 '編集状態にしたいため

  With Me.ActiveControl
    If (.Value) Then
      .Controls(0).BackStyle = 1
      dicNew.Item(CLng(.Tag)) = Null
    Else
      .Controls(0).BackStyle = 0
      dicNew.Remove CLng(.Tag)
    End If
  End With
End Function

Private Sub Form_Load()
  Dim sSql As String
  Dim rs As DAO.Recordset
  Dim i As Long
  Dim sN As String

  Set dic = CreateObject("Scripting.Dictionary")
  Set dicOld = CreateObject("Scripting.Dictionary")
  Set dicNew = CreateObject("Scripting.Dictionary")

  sSql = "SELECT * FROM T選手 ORDER BY よみ;"
  Set rs = CurrentDb.OpenRecordset(sSql)
  i = 0
  Do While (Not rs.EOF)
    i = i + 1
    If (i > iM6Count) Then Exit Do
    sN = "ck" & i
    dic.Item(rs("選手ID").Value) = sN
    With Me(sN)
      .Value = False
      .Tag = rs("選手ID")
      With .Controls(0)
        .Caption = rs("選手名")
        .BackStyle = 0
      End With
      .OnClick = "=ChkClick()"
      .Visible = True
    End With
    rs.MoveNext
  Loop
  rs.Close
  Set rs = Nothing
End Sub

Private Sub Form_Current()
  Dim sSql As String
  Dim rs As DAO.Recordset
  Dim i As Long

  Me.Painting = False
  For i = 1 To iM6Count
    With Me("ck" & i)
      If (Not .Visible) Then Exit For
      .Value = False
      .Controls(0).BackStyle = 0
    End With
  Next

  dicOld.RemoveAll
  dicNew.RemoveAll

  sSql = "SELECT * FROM T出場 WHERE 試合ID = " & Nz(Me.試合ID, 0) & ";"
  Set rs = CurrentDb.OpenRecordset(sSql)
  While (Not rs.EOF)
    i = rs("選手ID")
    dicOld.Item(i) = Null
    dicNew.Item(i) = Null
    With Me(dic.Item(i))
      .Value = True
      .Controls(0).BackStyle = 1
    End With
    rs.MoveNext
  Wend
  rs.Close
  Set rs = Nothing
  Me.Painting = True
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
  Cancel = True
  MsgBox "修正したら登録ボタンで確定", vbCritical
End Sub

Private Sub Form_Undo(Cancel As Integer)
  Dim v As Variant
  Dim i As Long

  Me.Painting = False
  For i = 1 To iM6Count
    With Me("ck" & i)
      If (Not .Visible) Then Exit For
      .Value = False
      .Controls(0).BackStyle = 0
    End With
  Next

  dicNew.RemoveAll
  If (dicOld.Count > 0) Then
    For Each v In dicOld.Keys
      dicNew.Item(v) = Null
      With Me(dic.Item(v))
        .Value = True
        .Controls(0).BackStyle = 1
      End With
    Next
  End If
  Me.Painting = True
End Sub

Private Sub btn1_Click()
  Dim sSql As String
  Dim sS As String
  Dim v As Variant

  If (Not Me.Dirty) Then Exit Sub

' 試合日など入力チェックをするのなら、この場所で

'
  sS = Me.BeforeUpdate
  Me.BeforeUpdate = ""
  Me.Dirty = False
  Me.BeforeUpdate = sS

  If (dicOld.Count > 0) Then
    For Each v In dicOld.Keys
      If (Not dicNew.Exists(v)) Then
        sSql = "DELETE * FROM T出場 WHERE 試合ID = " & Me.試合ID _
            & " AND 選手ID = " & v & ";"
        CurrentDb.Execute sSql
      End If
    Next
  End If
  If (dicNew.Count > 0) Then
    For Each v In dicNew.Keys
      If (Not dicOld.Exists(v)) Then
        sSql = "INSERT INTO T出場(試合ID, 選手ID) VALUES (" _
            & Me.試合ID & "," & v & ");"
        CurrentDb.Execute sSql
      End If
    Next
  End If
  Call Form_Current
End Sub

Private Sub Form_Close()
  Set dic = Nothing
  Set dicOld = Nothing
  Set dicNew = Nothing
End Sub

 

  上記フォームのVBA記述量削減・操作限定バージョン(F6M2)
  kEnt128_F62  kEnt128_F62D
このフォームでは、「F6M」の処理/操作を限定して、極力VBA記述を少なくしたものになります。

限定したのは、
・「T試合」の新規登録時のみ
・選手を追加したらフォームの手直しが必要
・この用途以外にチェックボックスがない事

チェックボックスは非連結で自由に配置しますが、以下の設定が必要です。
・チェックボックスの「タグ」には、「選手ID」を設定しておく
・チェックボックスのラベルには、その選手の「選手名」を表示するように
また、チェックボックス名は何でも構わない、個数も限定しない。

で、これを確認するフォームを作成するのですが、手修正も面倒なので・・・・
標準モジュール「M6M62」を用意しました。
(フォーム「F6M」を元に、上記条件に修正していくものです)
Public Sub M6toM62()
  Dim sSql As String
  Dim rs As DAO.Recordset
  Dim i As Long
  Const sSrcFname As String = "F6M"
  Const sFname As String = "F6M2"

  On Error Resume Next
  DoCmd.DeleteObject acForm, sFname
  DoCmd.CopyObject , sFname, acForm, sSrcFname
  DoCmd.OpenForm sFname, acDesign
  With Forms(sFname)
    .Caption = sFname
    .DataEntry = True
    sSql = "SELECT * FROM T選手 ORDER BY よみ;"
    Set rs = CurrentDb.OpenRecordset(sSql)
    i = 0
    While (Not rs.EOF)
      i = i + 1
      With .Controls("ck" & i)
        .Visible = True
        .Tag = rs("選手ID")
        .Controls(0).Caption = rs("選手名")
      End With
      rs.MoveNext
    Wend
    rs.Close
    Set rs = Nothing
  End With
End Sub

で、割り当てられていない不要なチェックボックスを削除するなりします。
(3列削除しましたが、配置はそのままにしたのが現状の「F6M2」です)

フォーム「F6M2」に記述したのは以下
Private Sub Form_Current()
  Dim ctl As Control

  For Each ctl In Me.Controls
    With ctl
      If (.ControlType = acCheckBox) Then
        .Value = False
      End If
    End With
  Next
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
  Cancel = True
  MsgBox "登録ボタンで確定", vbCritical
End Sub

Private Sub btn1_Click()
  Dim sSql As String
  Dim sS As String
  Dim ctl As Control

  If (Not Me.Dirty) Then Exit Sub

' 試合日など入力チェックをするのなら、この場所で

'
  sS = Me.BeforeUpdate
  Me.BeforeUpdate = ""
  Me.Dirty = False
  Me.BeforeUpdate = sS

  For Each ctl In Me.Controls
    With ctl
      If (.ControlType = acCheckBox And Len(.Tag) > 0) Then
        If (.Value) Then
          sSql = "INSERT INTO T出場(試合ID, 選手ID) VALUES (" _
              & Me.試合ID & "," & .Tag & ");"
          CurrentDb.Execute sSql
        End If
      End If
    End With
  Next
  Me.Requery
End Sub

 
新規登録時に、まずチェックボックスのチェックを外しておきます。
「登録」ボタンがクリックされた時に、チェックがあるものを探し出し、レコードを追加します。

チェック自体は「T試合」のものを入力していない状態でも、自由に ON / OFF できます。
なお、VBA記述を少なくするために、ラベル部分の背景色は変更していません。

登録ボタン「btn1」の最後で、Me.Requery しているのは、
新規登録を連続して行った場合、前のレコードに戻れたような気がして・・・・
もし、戻ったとした場合、チェックボックスの表示を処理できない・・・・
なので、Me.Requery して、新規レコードのみにするように・・・・


7)上記フォームの表示変更バージョン(F7M)
  kEnt128_F7
このフォームでは、「よみ」順に割り当てていく際に、あ行、か行・・・・行が変わったら1つ空けましょう。

フォーム「F6M」を「F7M」でコピーし、以下の記述を追加/修正します。
Private Function GyouNum(sSrc As String) As Long
  Select Case True
    Case sSrc Like "[あ-お]*": GyouNum = 0
    Case sSrc Like "[か-ご]*": GyouNum = 1
    Case sSrc Like "[さ-ぞ]*": GyouNum = 2
    Case sSrc Like "[た-ど]*": GyouNum = 3
    Case sSrc Like "[な-の]*": GyouNum = 4
    Case sSrc Like "[は-ぽ]*": GyouNum = 5
    Case sSrc Like "[ま-も]*": GyouNum = 6
    Case sSrc Like "[や-よ]*": GyouNum = 7
    Case sSrc Like "[ら-ろ]*": GyouNum = 8
    Case sSrc Like "[わ-ん]*": GyouNum = 9
    Case Else: GyouNum = 20
  End Select
End Function


Private Sub Form_Load()
  Dim sSql As String
  Dim rs As DAO.Recordset
  Dim iGyou As Long, iGyouNew As Long
  Dim i As Long
  Dim sN As String

  Set dic = CreateObject("Scripting.Dictionary")
  Set dicOld = CreateObject("Scripting.Dictionary")
  Set dicNew = CreateObject("Scripting.Dictionary")

  sSql = "SELECT * FROM T選手 ORDER BY よみ;"
  Set rs = CurrentDb.OpenRecordset(sSql)
  i = 0
  Do While (Not rs.EOF)
    iGyouNew = GyouNum(rs("よみ"))
    If (i = 0) Then iGyou = iGyouNew

    i = i + 1
    If (iGyou <> iGyouNew) Then i = i + 1
    iGyou = iGyouNew

    If (i > iM6Count) Then Exit Do
    sN = "ck" & i
    dic.Item(rs("選手ID").Value) = sN

また、チェックボックスをクリアする以下記述2か所を変更します。
  For i = 1 To iM6Count
    With Me("ck" & i)
      If (Not .Visible) Then Exit For
      .Value = False
      .Controls(0).BackStyle = 0
    End With
  Next

  Dim v As Variant

  For Each v In dic.Items
    With Me(v)
      .Value = False
      .Controls(0).BackStyle = 0
    End With
  Next

に。
これは、チェックボックスは連続して Visible = True になっているわけではないので・・・・
(フォーム「F6M」でも、下側記述で OK です)


8)単票にタブコントロール配置(F8M)(タブページで、あ行、か行・・・)
  実際に操作するのは、多数の非連結チェックボックス

  kEnt128_F8  kEnt128_F8D  kEnt128_F8_2000
このフォームでは、多数のチェックボックスをタブコントロールを使って、
あ行、か行・・・・をタブページで分けて表示しましょう・・・・というものです。
タブページには、非表示のチェックボックスを各30個配置しておきます。
(表示する時に使う分だけ可視に変更するのは、今まで通りです)
タブページ0には、標題「あ」、チェックボックス「ck1」~「ck30」
タブページ1には、標題「か」、チェックボックス「ck101」~「ck130」
・・・・
タブページ9には、標題「わ」、チェックボックス「ck901」~「ck930」
という規則を設けます。
また、今回はチェックボックスは横から採番しましょう・・・・

フォーム「F8M_BASE」(フォーム「F6M_BASE」をコピー)を用意し、
標準モジュール「M8Make」に用意した M8MakeProc を実行すると雰囲気フォームが出来上がります。
それをきれいに配置し直して保存します。
Private Const sFname As String = "F8M_BASE"
Private Const sFnew As String = "F8M"
Private Const IPX As Long = 567
Private Const iColCount As Long = 3
Public Const iM8Count As Long = 30

Public Sub M8MakeProc()
  Dim i As Long, j As Long
  Dim sN As String, sNc As String
  Dim iRow As Long, iCol As Long
  Dim ctl As Control
  Dim sAry() As String
  Const sPageCaption As String = "あ,か,さ,た,な,は,ま,や,ら,わ"

  On Error Resume Next
  sN = sFname & "_"
  DoCmd.DeleteObject acForm, sN
  DoCmd.CopyObject , sN, acForm, sFname
  DoCmd.OpenForm sN, acDesign

  With CreateControl(sN, acTabCtl, acDetail)
    .Name = "tb0"
    sAry = Split(sPageCaption, ",")
    While (.Controls.Count <= UBound(sAry))
      Call CreateControl(sN, acPage, acDetail, .Name)
    Wend
    For i = UBound(sAry) To 0 Step -1
      With .Controls(i)
        .Name = "tbp" & i
        .Caption = sAry(i)
        iRow = IPX * 1.5
        iCol = IPX * 0.5
        For j = 0 To iM8Count - 1
          With CreateControl(sN, acCheckBox, acDetail, .Name)
            sNc = "ck" & i * 100 + j + 1
            .Name = sNc
            .Top = (j \ iColCount) * IPX * 0.5 + iRow
            .Left = (j Mod iColCount) * IPX * 5 + iCol
            .Width = IPX * 0.4
            .Height = IPX * 0.4
            .DefaultValue = "0"
            .TabStop = False
            .Visible = False
          End With
          With CreateControl(sN, acLabel, acDetail, sNc)
            .Top = (j \ iColCount) * IPX * 0.5 + iRow
            .Left = (j Mod iColCount) * IPX * 5 + (IPX * 0.42) + iCol
            .Width = IPX * 2.6
            .Height = IPX * 0.42
            .BorderStyle = 1
            .BorderWidth = 1
            .BorderColor = RGB(0, 0, 0)
            .BackStyle = 0
            .BackColor = RGB(255, 240, 240)
          End With
        Next
      End With
    Next
    .Top = IPX * 1.5
    .Left = IPX * 0.5
    .Width = IPX * 14
    .Height = IPX * 6
  End With

  DoCmd.Close acForm, sN, acSaveYes
  DoCmd.DeleteObject acForm, sFnew
  DoCmd.Rename sFnew, acForm, sN
  DoCmd.OpenForm sFnew, acDesign
End Sub

この実行は結構時間がかかります。(初めは、おかしくなったのかと思い止めたりしてました)
タブコントロールの位置決めは難しいですね。(Top が今一つ決まりません)

フォーム「F8M」用のVBAを転記します(同じ標準モジュール内に用意済み)
フォーム「F8M」のVBA記述は「F7M」と大半同じで、以下 Form_Load の黄色部分が異なるだけです。
  Do While (Not rs.EOF)
    iGyouNew = GyouNum(rs("よみ"))
    If (i = 0) Then iGyou = iGyouNew
    i = i + 1
    If (iGyou <> iGyouNew) Then i = 1
    iGyou = iGyouNew
    If (iGyou > 10) Then Exit Do
    If (i > iM8Count) Then Exit Do
    sN = "ck" & iGyou * 100 + i

    dic.Item(rs("選手ID").Value) = sN

2000 のタブコントロール表示は、結構暗いですね。


9)単票に単票サブフォーム(F9M/F9S) (ワークテーブル使用)
  kEnt128_F9  kEnt128_F9D
VBA は記述したくない・・・ということだったので、テーブル「T出場」を以下の様にすると
チェックボックスを自由に配置できて、操作は楽に(VBA記述なし)なる・・・と言ったものの
これ以降に控えている操作等に支障が出てくると思います。
フィールド型 等々
 an オートナンバ (主キー)
 試合ID 長整数 「T試合」の試合ID
 ck1  Yes/No型 ルックアップはチェックボックス
 ck2  Yes/No型
 ・・・ 
 ck120  Yes/No型

何故か・・・
「ck1」はAさん用、「ck2」はBさん用 等、テーブル内にない取り決めが必要になります。
じゃ、これに近いテーブルをワークテーブル「Tワーク出場9」として使いましょう。
(・・・って VBA 必要になるんじゃ・・・・・横に置いとくとして)
フィールド型 等々
 an オートナンバ (主キー)
 試合ID 長整数 「T試合」の試合ID
 ck1  Yes/No型 ルックアップはチェックボックス
 ckn1  テキスト 選手名
 ck2  Yes/No型
 ckn2 テキスト 選手名
 ・・・ 
 ck120  Yes/No型
 ckn120 テキスト 選手名

【追記 5/15】
上記テーブルのフィールド「an」はありません。

「ck1」は XX さん用という取り決めが必要なので、テーブル「T選手」に情報を持ちましょう・・・・
テーブル「T選手」を「T選手9」にコピーして、フィールドを追加します。
フィールド型 等々
 選手ID オートナンバ (主キー)
 選手名 テキスト
 よみ テキスト
 ckno 数値 使用する ck の番号

標準モジュール「S9Make」にテーブル、連結した単票フォームを作成するVBAを用意しました。
Private Const sS9Table As String = "Tワーク出場9"
Private Const sCK As String = "ck"
Private Const sCKN As String = "ckn"
Private Const sFname As String = "F9S"
Private Const IPX As Long = 567
Private Const iRowCount As Long = 20
Public Const iS9Count As Long = 120

' サブフォーム F9S 参照のワークテーブルを作成する
'
Public Sub MakeWorkTable()
  Dim tdf As DAO.TableDef
  Dim i As Long

  On Error Resume Next
  With CurrentDb
    .TableDefs.Delete sS9Table
    Set tdf = .CreateTableDef(sS9Table)
    With tdf
      .Fields.Append .CreateField("試合ID", dbLong)
      For i = 1 To iS9Count
        .Fields.Append .CreateField(sCK & i, dbBoolean)
        .Fields.Append .CreateField(sCKN & i, dbText, 20)
      Next
    End With
    .TableDefs.Append tdf
    Set tdf = Nothing

    .TableDefs.Refresh
    With .TableDefs(sS9Table)
      For i = 1 To iS9Count
        With .Fields(sCK & i)
          .DefaultValue = "0"
          .Properties.Append .CreateProperty("DisplayControl", dbInteger, acCheckBox)
        End With
      Next
    End With
  End With
  RefreshDatabaseWindow
End Sub


' サブフォーム F9S 作成
'
Public Sub S9MakeProc()
  Dim i As Long
  Dim sN As String, sNc As String, sNt As String
  Dim iRow As Long, iCol As Long

  On Error Resume Next
  With CreateForm
    sN = .Name
    .RecordSource = sS9Table
    .RecordSelectors = False
    .NavigationButtons = False
    .AllowAdditions = False
    .AllowDeletions = False
    .ScrollBars = 0
    iRow = IPX * 0.27
    iCol = IPX * 0.27
    For i = 0 To iS9Count - 1
      sNc = sCK & i + 1
      sNt = sCKN & i + 1
      With CreateControl(sN, acCheckBox, acDetail, , sNc)
        .Name = sNc
        .Top = (i Mod iRowCount) * IPX * 0.55 + iRow
        .Left = (i \ iRowCount) * IPX * 3 + iCol
        .Width = IPX * 0.4
        .Height = IPX * 0.4
        .DefaultValue = "0"
        .TabStop = False
        .Visible = False
      End With
      With CreateControl(sN, acTextBox, acDetail, , sNt)
        .Name = sNt
        .Top = (i Mod iRowCount) * IPX * 0.55 + iRow
        .Left = (i \ iRowCount) * IPX * 3 + (IPX * 0.42) + iCol
        .Width = IPX * 2
        .Height = IPX * 0.45
        .Locked = True
        .TabStop = False
        .Visible = False
        .BackStyle = 1
        .BackColor = RGB(255, 255, 255)
      End With
    Next
  End With
  DoCmd.Close acForm, sN, acSaveYes
  DoCmd.DeleteObject acForm, sFname
  DoCmd.Rename sFname, acForm, sN
End Sub

 
ここで出来上がった「F9S」に以下を記述します。
Private Const EVENT_PROCEDURE As String = "[EVENT PROCEDURE]"
Dim WithEvents frm As Form

Dim dic As Object

Private Function TxtEnter(iNum As Long)
  With Me("ck" & iNum)
    .SetFocus
    If (Me.試合ID <> 0) Then .Value = Not .Value
  End With
End Function

Private Sub Form_Open(Cancel As Integer)
  Dim sSql As String
  Dim rs As DAO.Recordset, rsFrom As DAO.Recordset
  Dim i As Long

  On Error Resume Next
  Set frm = Me.Parent
  If (frm Is Nothing) Then
    Cancel = True
    Exit Sub
  End If

  frm.OnCurrent = EVENT_PROCEDURE
  frm.AfterUpdate = EVENT_PROCEDURE

  Set dic = CreateObject("Scripting.Dictionary")

  sSql = "DELETE * FROM Tワーク出場9;"
  CurrentDb.Execute sSql
  Set rs = CurrentDb.OpenRecordset("Tワーク出場9")
  rs.AddNew
    sSql = "SELECT * FROM T選手9 WHERE ckno > 0 AND ckno <= " & iS9Count & ";"
    Set rsFrom = CurrentDb.OpenRecordset(sSql)
    While (Not rsFrom.EOF)
      i = rsFrom("ckno")
      dic.Item(rsFrom("選手ID").Value) = "ck" & i
      Me("ck" & i).Visible = True
      With Me("ckn" & i)
        With .FormatConditions
          .Delete
          With .Add(acExpression, , "[ck" & i & "]=True")
            .BackColor = RGB(255, 240, 240)
          End With
        End With
        .OnEnter = "=TxtEnter(" & i & ")"
        .Visible = True
      End With
      rs("ckn" & i) = rsFrom("選手名")
      rsFrom.MoveNext
    Wend
    rsFrom.Close
    Set rsFrom = Nothing
  rs.Update
  rs.Close
  Set rs = Nothing
End Sub

Private Sub frm_Current()
  Dim sSql As String
  Dim rs As DAO.Recordset, rsFrom As DAO.Recordset
  Dim i As Long
  Dim id As Long

  Set rs = CurrentDb.OpenRecordset("Tワーク出場9")
  rs.Edit
    For i = 1 To iS9Count
      rs("ck" & i) = False
    Next
    id = Nz(frm.試合ID)
    rs("試合ID") = id
    If (id <> 0) Then
      sSql = "SELECT ckno FROM T出場 INNER JOIN T選手9 " _
          & "ON T出場.選手ID = T選手9.選手ID " _
          & "WHERE T出場.試合ID = " & id & ";"
      Set rsFrom = CurrentDb.OpenRecordset(sSql)
      While (Not rsFrom.EOF)
        i = rsFrom(0)
        If (i > 0 And i <= iS9Count) Then rs("ck" & i) = True
        rsFrom.MoveNext
      Wend
      rsFrom.Close
      Set rsFrom = Nothing
    End If
  rs.Update
  rs.Close
  Set rs = Nothing
  Me.Requery
End Sub

Private Sub frm_AfterUpdate()
  Call frm_Current
End Sub

Private Sub Form_Dirty(Cancel As Integer)
  If (Me.試合ID = 0) Then Cancel = True
End Sub

Private Sub Form_AfterUpdate()
  Dim sSql As String
  Dim v As Variant
  Dim i As Long

  sSql = "DELETE * FROM T出場 WHERE 試合ID = " & Me.試合ID & ";"
  CurrentDb.Execute sSql

  For Each v In dic.Keys
    With Me(dic.Item(v))
      If (.Value) Then
        sSql = "INSERT INTO T出場(試合ID, 選手ID) VALUES (" _
            & Me.試合ID & "," & v & ");"
        CurrentDb.Execute sSql
      End If
    End With
  Next
End Sub

Private Sub Form_Close()
  Set frm = Nothing
End Sub

 
メインとなるフォーム「F9M」はフォーム「F6M_BASE」をコピーしたもの。
そこに、この「F9S」をドラッグ&ドロップしてサブフォームとして組み込み、
リンク親/子フィールドは削除(空欄に)します。

どの選手が、どの「ck」を使うか、テーブル「T選手9」の「ckno」を変更しない限り、
その選手はその番号を使う事になるので、連結されたチェックボックス/テキストボックスを
(ペアにして)自由に移動配置できます。

なお、このワークテーブル「Tワーク出場9」のレコードは1件だけ。
それを UPDATE で使い回しします。
(処理対象でない試合のものに対して、レコードをいじりたくないので)
連結にしてみたものの、何か遠まわりしているような・・・・していないような・・・
でも、ガ~~ってチェックして、それを取り消すのは楽かな。
メイン/サブの構成になったので、「登録/修正」用のボタンはなし。

今までのフォームと表示が異なっていますが、気がつかれたでしょうか。
今までのフォームの表示順は、「よみ」順になっていましたが、
このフォームでは選手の登録順(ckno の順)になっています。
(配置を移動していなかったので、そう見えたという事だけですけど)

そうそう
このフォームだったと思うけど、Form_Open / Form_Load が連続して呼ばれない・・・
当初 Form_Open / Form_Load は以下のような感じ
Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  If (Me.Parent.Name = "") Then
    Cancel = True
  End If
End Sub

Private Sub Form_Load()
  Dim sSql As String
  Dim rs As DAO.Recordset, rsFrom As DAO.Recordset
  Dim i As Long

  Set frm = Me.Parent
  frm.OnCurrent = EVENT_PROCEDURE
  frm.AfterUpdate = EVENT_PROCEDURE

  Set dic = CreateObject("Scripting.Dictionary")
  ・・・・
Form_Open でやっているのは、過去記事にもいろいろと書いてましたが、
サブフォームとして起動されていなかったら表示しない・・・・
でも、この後の
Private Sub frm_Current()
  Dim sSql As String
  Dim rs As DAO.Recordset, rsFrom As DAO.Recordset
  Dim i As Long
  Dim id As Long

  Set rs = CurrentDb.OpenRecordset("Tワーク出場9")
  rs.Edit ' ★★★1
    For i = 1 To iS9Count
      rs("ck" & i) = False
    Next
    id = Nz(frm.試合ID) ' ★★★2
    rs("試合ID") = id
    ・・・・

★★★1 部分だったかで「カレントレコードがない」エラー(だったか)
★★★2 部分だったかで frm がどうたらだったか・・・

で、2000 の方でチョッといじっていると、動いてみたり・・・
同じVBA記述構成の他のフォームは動いていたり・・・・

なので、サブフォームになる Form_Open / Form_Load は Open 1つに(全部書き直し)

【追記 5/15】
ここで示した箇所の例はですね。
  Set frm = Me.Parent
  frm.OnCurrent = EVENT_PROCEDURE
されていないと、frm_Current は動きませんよね・・・・

でも、どこかのフォームでなっていたんですよ・・・・
ま、私の中での出来事と言う事で・・・・・


注意事項)
・メイン/サブの構成では、サブ側でメインのイベントを受け取る設定をするので
 メイン側フォームのプロパティ「コード保持」は「はい」としておきます。
 (メイン側に VBA 記述がなくても)
 (F2M/F2S1/F2S2 では、「T試合」を表示している F2S1 が対象)

・フォーム「F6M」以降のフォームで、選手を割付ける際、割り付けきらなかったとか・・・・
 以降の処理でエラーになる可能性・・・大・大・大



どの方法が良いのだろう・・・・


サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt128_2000.zipkEnt128_2003.zipkEnt128_2007.zip
 サイズ 235,266250,196266,826
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2012/05/14

Category: サンプルかな

TB: 0  /  CM: 0

top △

この記事に対するコメント

top △

コメントの投稿

Secret

top △

トラックバック

トラックバックURL
→http://kikutips.blog13.fc2.com/tb.php/128-1ea9bd48
この記事にトラックバックする(FC2ブログユーザー)

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。