スポンサーサイト 


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

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

フォームを増殖させる 


副題:Collection より Dictionary が好き

「フォームを増殖させる」方法のサンプルを作成するにあたり、
「ドラクエ」云々が最近のニュースであったので、Ⅷでの錬金をサンプルデータに使ってみます。

※ サンプルデータは雰囲気です
 Web 等で攻略サイトの方を信じてください

以下の様な、見るだけフォームがあったとします。

kEnt190.jpg

出現するアイテムが左側のリストボックスに表示されます。
そのアイテムは、上側オプショングループでの種類に属する事になります。
オプショングループを選択し直すと、左側リストボックス内の表示が切り替わります。
リストボックス内のアイテムを選択すると、
・どこで売っているものなのか等・・・ 右側のリストボックスに表示されます。
・また、選択したアイテムを使った「錬金」情報があれば、下側サブフォームコントロールに
 表示される事になります。

kEnt190_1.jpg

上記画面で、錬金情報の「ブロンズナイフ」の情報は・・・ というと
・左側リストボックスから、「ブロンズナイフ」を選択すれば、それに関する情報で表示されます。

kEnt190_2.jpg

さて、ここからですが・・・
・初めの、「どうのつるぎ」情報を表示しつつ、
・「ブロンズナイフ」の情報を同じフォームを使って、別フォームとして表示したい・・・・・

つまり、以下の様な画面の推移になります。

kEnt190_31.jpg ⇒ kEnt190_32.jpg ⇒ kEnt190_33.jpg

・「どうのつるぎ」を選択
・「錬金」内の「ブロンズナイフ」をダブルクリック
・「錬金」内の「石のぼうし」をダブルクリック

その後、再度「ブロンズナイフ」をダブルクリックしたら、
・「ブロンズナイフ」のフォームは既に表示しているので、前面に移動させるだけ・・・

kEnt190_34.jpg

増殖させたフォームでの操作に制限はありません。
・オプショングループでの種類を選択し直したり
・異なるアイテムを選択し直したり
・・・自由です。
ただ、自分が何で増殖されたのか・・・ これを変更することはできません。
例えば、上記で「ブロンズナイフ」で増殖されたフォームを操作して違う表示にしていても、
操作の過程(ダブルクリック)で「ブロンズナイフ」の表示が必要になったら、
「ブロンズナイフ」の情報に戻された状態で表示される事になります。
自分が何で増殖されたのかは、フォームの標題部分でわかると思います。

なお、この増殖させたフォームの終わり方は、右上の「×」で閉じますが
・増殖させたフォームであれば、そのフォームだけ
・元々のフォームであれば、増殖させたフォーム全部閉じるようにしました。

上記の画面の推移では、見易い様にフォームを配置し直していますが、ポンポン重なって増殖します。
これを確認するフォームは「F1」になります。

そこで、フォーム増殖したものは何・・・ っていう管理用フォームも表示しましょうか・・・
これを確認するフォームは「F2」になります。

・「どうのつるぎ」を選択
・「錬金」内の「ブロンズナイフ」をダブルクリック
すると以下の様な画面になります。

kEnt190_41.jpg ⇒ kEnt190_42.jpg

表示される「フォーム選択」フォームを横に移動しておいて、増殖を繰り返していくと以下の様な感じに

kEnt190_43.jpg

「フォーム選択」で選ぶと、そのフォームが最前面に表示されるようになります。

この「フォーム選択」を「×」で閉じると、増殖させたフォーム全部を閉じるようにしました。
つまり、元々のフォーム「F2」だけが表示されるように・・・
また、フォーム「F2」を表示して、「×」で閉じた時には、
全フォーム(増殖したフォーム全部+「フォーム選択」フォーム)を閉じます。

この「フォーム選択」フォームが「F2_Menu」
単票フォームにコマンドボタンを16個配置しておいて、使う分を表示しましょう・・・・
16個以上の増殖フォームがあったら表示できる分だけ表示しましょう・・・・
(表示できないだけで、フォームの管理はやってます)

表示個数を制限するのもなぁ~ ということでフォーム「F3_Menu」
帳票フォームにしておいて、フォームのレコードセットには
・内部でテーブルとは関係ない ADO のインメモリレコードセットを作成し、
 それをフォームのレコードセットに使いましょう・・・・
※ この「F3_Menu」は、動きはしますが 2000 ではまともに表示されません
 (バージョンの違いという事で・・・:2000 の mdb を例えば 2007 で動かすとまともです)

kEnt190_44.jpg  kEnt190_45.jpg

副題にも上げていましたが、増殖させたフォームの管理に Dictionary を用います。

※ この記事の目的は、フォームを増殖させる方法です
  サンプルデータは、それを説明する為のデータにすぎませんので・・・
 
まずは、サンプル用テーブルは以下の5つ(表示データは一部)

「T_種類」
sid種類
1武器
2


「T_アイテム」
iidsidアイテム買値売値摘要攻撃防御備考
1武器石のつるぎ   主--- 12  
2武器きせきのつるぎ \1,000主-ゼ- 80  
※ 「sid」は「T_種類」をルックアップ

「T_街」
tid街名等
1トラペッタ
2リーザス村


「T_購入」
antidiid買値売値
1トラペッタひのきのぼう\10\5
2トラペッタこんぼう\110\55
※ 「tid」は「T_街」をルックアップ / 「iid」は「T_アイテム」をルックアップ

「T_錬金」
anridmnoridsiid
11あくまのムチ1バスターウィップ
21あくまのムチ2あくまのしっぽ
32アサシンダガー1イーグルダガー
42アサシンダガー2どくばり
53石のオノ1石のぼうし
63石のオノ2ひのきのぼう
74ウィングエッジ1やいばのブーメラン
84ウィングエッジ2はがねのかま
94ウィングエッジ3こうもりの羽
※ 「mno」および「iid」は「T_アイテム」をルックアップ

ここのテーブルは
ridiid
1あくまのムチ
2アサシンダガー
3石のオノ
4ウィングエッジ
※「iid」は「T_アイテム」をルックアップ

anridridsiid
111バスターウィップ
212あくまのしっぽ
321イーグルダガー
422どくばり
531石のぼうし
632ひのきのぼう
741やいばのブーメラン
842はがねのかま
943こうもりの羽
※「iid」は「T_アイテム」をルックアップ

に分けた方が良かったかも・・・
ただ、同じものを作るのに複数通りあったりで・・・
どっちのほうがメンテしやすいかな・・・???

今回の例では合体版という事で


フォーム「F1」

kEnt190_D1.jpg

上側に配置するのは、オプショングループ「op1」
「T_種類」の「sid」が値となる様にトグルボタンを配置し、全部⇒値:0 としておきます。

左側に配置するリストボックス「lst1」では、上側オプショングループ値を参照しアイテム表示します。
値集合ソースは、
SELECT iid, アイテム FROM T_アイテム WHERE IIf([op1]=0,True,[sid]=[op1]) ORDER BY iid;
として「op1」値で表示を切り替えます(実際の記述は、テーブル修飾が付いたりしてますが・・・)
※ リストボックス/コンボボックスに記述するSQLでは、同一フォームにあるコントロールについて
  名前だけで良いみたい・・・・ これは覚えておいた方が良いですね。
表示では、「アイテム」だけが見えるように列幅を設定しておきます。

右側リストボックス「lst2」では、どこで売っているかが見れれば・・・・
選択して何かする・・・ 考えていないので、連結列の値が重複しても構わない表示とします。
値集合ソースは、
SELECT Q1.iid, Q2.街名等,
IIF(Q2.買値 Is Not Null,Q2.買値,Q1.買値) AS 買値,
IIF(Q2.売値 Is Not Null,Q2.売値,Q1.売値) AS 売値,
Q1.摘要, Q1.攻撃, Q1.防御
FROM T_アイテム AS Q1 LEFT JOIN
(SELECT Q3.iid, Q3.買値, Q3.売値, Q4.tid, Q4.街名等 FROM T_購入 AS Q3
INNER JOIN T_街 AS Q4 ON Q3.tid=Q4.tid) AS Q2 ON Q1.iid=Q2.iid
WHERE Q1.iid=[lst1]
ORDER BY Q2.tid;
としていました。
「T_購入」テーブルと「T_街」テーブルを「tid」で結び付けたものと、
リストボックス「lst1」で選択された「T_アイテム」の情報を外部結合して・・・
街で売っているものであれば、Q2.買値 / Q2.売値 部分は Null になる事はないので・・・・
※ 実際には、過剰仕様なのかと・・・・
 アイテムの売り買いが場所によって高い/安いがあるのであれば・・・
 ・・・で、「T_購入」に「買値」「売値」を設けていましたが・・・ 同じみたい
※ SQL 内の IIF でも、Is Null / Is Not Null が使えるみたい・・・

下側の錬金部分はサブフォームコントロール「FSUB」
初期には組み込みしておきません。
左側リストボックスで選択された時に、
・どの「iid」(アイテムid)を表示して・・・・
これを Tag に設定してから、サブフォーム用「FS1」を組み込みます。

ここの設定はこんな感じです・・・
操作の流れとしては
・「読み込み時」に
 左側リストボックス「lst1」に全部を表示したいので
 上側オプショングループの値を 全部:0 にしてから、その更新後処理を走らせる
※ 単なる既定値の利用だけでは、左側リストボックス「lst1」に何件表示されているか・・・
 この表示更新が出来ないため・・・
・上側オプショングループ「op1」が変更されたら
 左側リストボックス「lst1」を未選択にして再クエリ
 その後、何件のリストが出来上がったのかを「lst1」についているラベルに設定
※ 何件・・・ 別の方法として、テキストボックスのコントロールソースに設定して表示・・・ でも
・左側リストボックス「lst1」がクリックされたら
 右側リストボックスの更新と
 サブフォームの組み込み
※ 「Click」は「AfterUpdate」後に呼ばれる見たい(結構 Click で処理を記述しますね・・)
・「閉じる時」に
 閉じますよ・・・ これを教えてあげる(関数内の記述内容は後述)

記述したのは以下
Private Sub Form_Load()
  Me.op1 = 0
  Call op1_AfterUpdate
End Sub

Public Sub op1_AfterUpdate()
  With Me.lst1
    .Value = Null
    .Requery
    .Controls(0).Caption = .ListCount & " 種類"
  End With
End Sub

Public Sub lst1_Click()
  Me.Painting = False
  Me.lst2.Requery
  Me.lst2 = Null
  Me.Tag = Me.lst1
  Me.FSUB.SourceObject = "FS1"
  Me.Painting = True
End Sub

Private Sub Form_Close()
  Call RemoveForm1
End Sub

 
※ lst1_Click 処理を Painting で挟んでみましたが、効果は・・・???
※ フォームを増殖した時に、
 op1_AfterUpdate() / lst1_Click() を呼び出したいので Public に変更しています。
※※ フォーム増殖用関数を作って・・・ でも良いと思いますが・・・


組み込み用フォーム「FS1」

錬金用のサブフォームとして組み込まれるものになります。

kEnt190_D2.jpg

このフォームでは、
起動時に親の Tag に設定された「iid」(アイテムid)を元にクロス集計表示します。
今回のデータでは「ブロンズナイフ」は iid=40 になっています。
  sSql = "TRANSFORM First(iid) AS 値 " _
    & "SELECT rid, First(mno) AS m_iid " _
    & "FROM T_錬金 " _
    & "WHERE (mno = {%1}) OR (rid IN (SELECT rid FROM T_錬金 WHERE iid={%1})) " _
    & "GROUP BY rid " _
    & "PIVOT rids; "

  sSql = Replace(sSql, "{%1}", 40)
  Me.RecordSource = sSql
とすると、以下のデータが得られます。
ridm_iid123
28114040 
9016816140 
1182111854040
15926240261 

数値だけのデータですね・・・
これをフォーム上で文字列に変換します。
非表示のコンボボックス「cbx0」~「cbx3」の4つを配置します。
各コンボボックスの値集合ソースは同じで、
SELECT iid, アイテム FROM T_アイテム;
としておきます。
「cbx0」のコントロールソースを「m_iid」
「cbx1」~「cbx3」のコントロールソースを 1 ~ 3
「cbx0」~「cbx3」に対応する可視のテキストボックス「txt0」~「txt3」を配置します。
「txt0」~「txt3」のコントロールソースは、対応するコンボボックスの Column(1) を参照する様に・・・
また、「txt0」~「txt3」に条件付き書式を設定して、
対応するコンボボックスの値が親から指定された値と同じだったら・・・・
このコントロール群で表示はできますが、見栄え上で、フォーカスがテキストボックスに自動で入らない様に、
透明のコマンドボタンを配置して、タブ移動順を先頭にしておきました。

動き的には、
・親の Tag を参照して、表示対象の iid (アイテムid)を得ておきます。
 この時、参照エラーになったら組み込み起動ではないんでしょう・・・ Cancel = True で起動されない様に
※ 今回の例では、親の Tag ではなくて、親の lst1 を参照すれば良いのですが・・・
 あまりコントロール名でガチガチにしてもなぁ・・・
 lst1 を別名に変更したら、変更範囲が広くなっちゃうし・・・
 サブフォーム組み込みフォームへの情報伝達に、親の Tag を使う・・・ 私は良くします。
・レコードソースを設定して
・「cbx1」~「cbx3」および「txt0」~「txt3」のコントロールソースを設定
・「txt0」~「txt3」に条件付き書式を設定しつつ、ダブルクリック時の処理を設定

「txt0」~「txt3」がダブルクリックされ、テキストボックスのダブルクリック処理をそのままに戻ると、
ダブルクリック位置で文字列反転表示されるので、以降の処理を DoCmd.CancelEvent でキャンセルに
対象のテキストボックスが Null であれば元々のデータはないんでしょう・・・
で、対応するコンボボックスの値が、親指定の値じゃなかったら・・・
その値を使ってフォームを増殖・・・・

記述したのは以下
Dim iid As Long

Private Function WakeUpFrmClick()
  DoCmd.CancelEvent
  With Me.ActiveControl
    If (IsNull(.Value)) Then Exit Function
    With Me("cbx" & Right(.Name, 1))
      If (.Value <> iid) Then Call WakeUpForm1(.Value)
    End With
  End With
End Function

Private Sub Form_Open(Cancel As Integer)
  Dim sSql As String
  Dim i As Long

  On Error Resume Next
  iid = Me.Parent.Tag
  If (Err <> 0) Then
    Cancel = True
    Exit Sub
  End If

  sSql = "TRANSFORM First(iid) AS 値 " _
    & "SELECT rid, First(mno) AS m_iid " _
    & "FROM T_錬金 " _
    & "WHERE (mno = {%1}) OR (rid IN (SELECT rid FROM T_錬金 WHERE iid={%1})) " _
    & "GROUP BY rid " _
    & "PIVOT rids; "

  sSql = Replace(sSql, "{%1}", iid)
  Me.RecordSource = sSql

  Me.cbx0.ControlSource = "m_iid"
  Me.txt0.ControlSource = "=[cbx0].[Column](1)"
  For i = 1 To 3
    Me("cbx" & i).ControlSource = i
    Me("txt" & i).ControlSource = "=[cbx" & i & "].[Column](1)"
  Next

  For i = 0 To 3
    With Me("txt" & i)
      .OnDblClick = "=WakeUpFrmClick()"
      With .FormatConditions
        .Delete
        With .Add(acExpression, , "[cbx" & i & "]=" & iid)
          .BackColor = RGB(200, 240, 255)
        End With
      End With
    End With
  Next
End Sub

 
※ クロス集計で、「 As m_iid 」部分を「 As 0 」にしておけば、
 コントロールソースを設定する部分等、もっとまとめる事が出来ますね・・・(未検証)

この、フォーム「F1」および「FS1」で記述していた増殖部分の関数
WakeUpForm1 / RemoveForm1 は、標準モジュール「Module1」にまとめて記述しています。


標準モジュール「Module1」

WakeUpForm1(iNum As Long)

増殖する iid (アイテムid)を引数に指定します。
これは、組み込まれたサブフォームのテキストボックスのダブルクリック時に呼ばれます。
この iid を Dictionary のキーとして管理します。
キーが存在したら、既に表示しているフォームにフォーカスを設定します。
キーが存在しなかったら、dic.Add iNum, New Form_F1 として新しくフォーム「F1」を生成し管理します。
その後、フォーム「F1」の操作の流れで、
・iid から sid を求めて、オプショングループの値を設定して、更新後処理を
・左側リストボックスの値を設定して、クリック処理を
フォームの標題に、アイテムの文字列の後に 「:」 を付加して、iid も表示しておきます。
この標題に付加した iid を今後使っていきます(後述)
※ 本来であれば、フォームの識別子役に Tag を使ってますが・・・
 ・・・ 今回 Tag はサブフォームへの情報渡しに使っているので、上記付加する方法としました。
新しく生成しただけでは表示されていないので、Visible = True で表示します。
既存のものに対しても Visible = True しますが、悪影響はないでしょう・・・ ということで

RemoveForm1()

これは、フォーム「F1」の閉じる時に呼ばれます。
誰から呼ばれたのか・・・ CodeContextObject.Caption を入手し判別します。
※ 元々のフォーム「F1」のウィンドウのタイトル部分に「F1」が表示されていますが、
 標題は設定していないので "" が得られる事になります。
 ま、以下の判別は、標題を設定する事があるかもしれない・・・ ということで
 標題を設定する事があれば、「:」は使わない事・・・

「:」が存在したら増殖したフォームから・・・・ 「:」以降を数値にして Dictionary からキーを削除します。
「:」が存在しなかったら元々のフォーム「F1」から・・・
 ・・・ Dictionary を綺麗サッパリします。( dic.RemoveAll )
Dictionary からキーを削除することで、フォームを閉じる事が出来ます。

記述したのは以下
Dim dic As Object

Public Sub WakeUpForm1(iNum As Long)
  Dim frm As Form
  Dim sS As String

  On Error Resume Next
  If (dic Is Nothing) Then Set dic = CreateObject("Scripting.Dictionary")
  If (dic.Exists(iNum)) Then
    dic(iNum).SetFocus
  Else
    dic.Add iNum, New Form_F1
  End If
  With dic(iNum)
    .op1 = DLookup("sid", "T_アイテム", "iid=" & iNum)
    Call .op1_AfterUpdate
    .lst1 = iNum
    .Caption = .lst1.Column(1) & ":" & iNum
    Call .lst1_Click
    .Visible = True
  End With
End Sub

Public Sub RemoveForm1()
  Dim sS As String

  On Error Resume Next
  sS = CodeContextObject.Caption
  If (InStr(sS, ":") = 0) Then
    dic.RemoveAll
  Else
    dic.Remove Int(Split(sS, ":")(1))
  End If
End Sub

 

フォーム「F2」と組み込み用フォーム「FS2」

フォーム「F1」を「F2」名でコピー
フォーム「FS1」を「FS2」名でコピー
その後、以下部分だけを変更します。

フォーム「F2」

Private Sub Form_Load()
  Me.op1 = 0
  Call op1_AfterUpdate
End Sub

Public Sub op1_AfterUpdate()
  With Me.lst1
    .Value = Null
    .Requery
    .Controls(0).Caption = .ListCount & " 種類"
  End With
End Sub

Public Sub lst1_Click()
  Me.Painting = False
  Me.lst2.Requery
  Me.lst2 = Null
  Me.Tag = Me.lst1
  Me.FSUB.SourceObject = "FS2"
  Me.Painting = True
End Sub

Private Sub Form_Close()
  Call RemoveForm2
End Sub

 
組み込み用フォーム「FS2」

Dim iid As Long

Private Function WakeUpFrmClick()
  DoCmd.CancelEvent
  With Me.ActiveControl
    If (IsNull(.Value)) Then Exit Function
    With Me("cbx" & Right(.Name, 1))
      If (.Value <> iid) Then Call WakeUpForm2(.Value)
    End With
  End With
End Function

Private Sub Form_Open(Cancel As Integer)
  Dim sSql As String
  Dim i As Long

  On Error Resume Next
  iid = Me.Parent.Tag
  If (Err <> 0) Then
    Cancel = True
    Exit Sub
  End If

  sSql = "TRANSFORM First(iid) AS 値 " _
    & "SELECT rid, First(mno) AS m_iid " _
    & "FROM T_錬金 " _
    & "WHERE (mno = {%1}) OR (rid IN (SELECT rid FROM T_錬金 WHERE iid={%1})) " _
    & "GROUP BY rid " _
    & "PIVOT rids; "

  sSql = Replace(sSql, "{%1}", iid)
  Me.RecordSource = sSql

  Me.cbx0.ControlSource = "m_iid"
  Me.txt0.ControlSource = "=[cbx0].[Column](1)"
  For i = 1 To 3
    Me("cbx" & i).ControlSource = i
    Me("txt" & i).ControlSource = "=[cbx" & i & "].[Column](1)"
  Next

  For i = 0 To 3
    With Me("txt" & i)
      .OnDblClick = "=WakeUpFrmClick()"
      With .FormatConditions
        .Delete
        With .Add(acExpression, , "[cbx" & i & "]=" & iid)
          .BackColor = RGB(200, 240, 255)
        End With
      End With
    End With
  Next
End Sub

 
サブフォームとして組込むフォーム名は違くなりますが、その他は関数名が違う位ですね・・・
つまり、標準モジュールに記述する関数で、処理の違いを埋めます。
それを記述したのが、標準モジュール「Module2」になりますが・・・

その前に・・・

フォーム選択用フォーム「F2_Menu」

kEnt190_D3.jpg

増殖したフォームの一覧を表示する単票フォームになります。
フォームの構成は、
・非表示のヘッダにコンボボックス「cbx1」を配置
 値集合ソースは、
 SELECT iid, アイテム FROM T_アイテム;
 としておきます。
・フォームの詳細部分にコマンドボタンを 16 個上から順に作っておきます。
 (名前は問わない処理としたので、可能な限り並べても・・・)

このフォームは、起動された時に表示するデータは持ち合わせていないので、チョッと工夫を・・・
フォームを起動する際に、OpenArgs に文字列(内容を問わず)を設定しておきます。
フォームを直接クリック起動した際には OpenArgs は設定されないので、それを利用する事に・・・
OpenArgs に何かが設定されていたら・・・
・コマンドボタンのクリック時に実行する関数を登録し
・表示するデータを Public Sub SetMenu(vAry As Variant) で待つ
 引数は、表示する iid の配列( Dictionary 管理の dic.Keys 生成そのままの配列)
・コマンドボタン1つ目には、元々フォーム用に・・・
・コマンドボタン2つ目以降に、iid 配列から文字列にしたものを設定
 通常は、
 DLookup("アイテム", "T_アイテム", "iid=" & iid)
 で求められますが、違う方法で・・・・
 非表示ヘッダに配置したコンボボックス「cbx1」に iid を設定して、結果 Column(1) を得る・・・
・コマンドボタンに何の iid を割り当てたか・・・ コマンドボタンの Tag に設定しておきます。
 コマンドボタン1つ目の Tag には、iid に使っていない 0 を設定しておきます。
・指定された iid 配列以上のコマンドボタンは非表示にしておきます。
・コマンドボタンがクリックされたら、Tag の値で再表示要求します。
  Call ShowForm2(Me.ActiveControl.Tag)
・フォームが閉じられたら、Dictionary 管理をクリアする要求を出します。

まっ、動き的にはこんな感じで・・・・ 記述したのは以下
Private Function ClickBtn()
  Call ShowForm2(Me.ActiveControl.Tag)
End Function

Private Sub Form_Open(Cancel As Integer)
  If (Len(Nz(Me.OpenArgs)) = 0) Then Cancel = True
End Sub

Private Sub Form_Load()
  Dim i As Long

  With Me.Section(acDetail)
    For i = 0 To .Controls.Count - 1
      .Controls(i).OnClick = "=ClickBtn()"
    Next
  End With
End Sub

Public Sub SetMenu(vAry As Variant)
  Dim i As Long

  Me.cbx1.Requery
  With Me.Section(acDetail)
    With .Controls(0)
      .Caption = "F2 TOP"
      .Tag = 0
      .Visible = True
      .SetFocus
    End With
    For i = 0 To UBound(vAry)
      If ((i + 1) > .Controls.Count) Then Exit For
      With .Controls(i + 1)
        Me.cbx1 = vAry(i)
        .Caption = Me.cbx1.Column(1)
        .Tag = vAry(i)
        .Visible = True
      End With
    Next
    For i = i + 1 To .Controls.Count - 1
      .Controls(i).Visible = False
    Next
  End With
End Sub

Private Sub Form_Close()
  Call DelForm2
End Sub

 
これらフォームの関係を元に、標準モジュール「Module2」を考えていきます。


標準モジュール「Module2」

まず、Dictionary にフォームを生成する管理部分は同じですが、
それ用にフォームを操作(「op1」「lst1」設定)する部分は
・生成した後(既に生成済みを含む)
・フォーム選択からコマンドボタンクリックされた時
の2つの呼ばれ方があるので共通の関数( ShowForm2 )に・・・
引数で iid を指定しますが、フォーム選択で元々を選んだ時( Tag=0 )は、Dictionary に無い・・・
その違いを吸収するために、再度 Dictionary のキーに iid があるか・・・ 判別しています。
上記、後者の場合は iid の配列を再度受け取る必要はないので、
前者の場合は「フォーム選択」用フォームを起動して、dic.Keys で iid の配列を渡します。
(既表示 iid フォームの場合、無駄な処理になりますが・・・ 遅すぎる処理になるのなら考え直し要)
・増殖フォームが1つ1つ閉じられた場合、結果、管理数が 0 なら「フォーム選択」フォームを閉じる

雰囲気、こんな感じで・・・・記述したのは以下
Const CFMENU As String = "F2_Menu"
'Const CFMENU As String = "F3_Menu"
Dim dic As Object

Public Sub WakeUpForm2(iNum As Long)
  Dim frm As Form
  Dim sS As String

  On Error Resume Next
  If (dic Is Nothing) Then Set dic = CreateObject("Scripting.Dictionary")
  If (Not dic.Exists(iNum)) Then
    dic.Add iNum, New Form_F2
  End If
  Call ShowForm2(iNum)
  Call ShowMenu(dic.Keys)
End Sub

Public Sub ShowForm2(iNum As Long)
  If (dic.Exists(iNum)) Then
    With dic(iNum)
      .op1 = DLookup("sid", "T_アイテム", "iid=" & iNum)
      Call .op1_AfterUpdate
      .lst1 = iNum
      .Caption = .lst1.Column(1) & ":" & iNum
      Call .lst1_Click
      .Visible = True
      .SetFocus
    End With
  Else
    Forms("F2").SetFocus
  End If
End Sub

Private Sub ShowMenu(vAry As Variant)
  If (Not CurrentProject.AllForms(CFMENU).IsLoaded) Then
    DoCmd.OpenForm CFMENU, , , , , , "Dmy"
  End If
  Call Forms(CFMENU).SetMenu(vAry)
End Sub

Public Sub RemoveForm2()
  Dim sS As String

  On Error Resume Next
  sS = CodeContextObject.Caption
  If (InStr(sS, ":") = 0) Then
    dic.RemoveAll
  Else
    dic.Remove Int(Split(sS, ":")(1))
  End If

  If (dic.Count = 0) Then
    DoCmd.Close acForm, CFMENU, acSaveNo
  Else
    Call ShowMenu(dic.Keys)
  End If
End Sub

Public Sub DelForm2()
  dic.RemoveAll
End Sub

 
※ どの「フォーム選択」用フォームを起動するか・・・
Const CFMENU As String = "F2_Menu"
'Const CFMENU As String = "F3_Menu"
この部分、どちらを有効にするか・・・ だけです。
(変更しないと、「F3_Menu」の確認はできません)

では、帳票フォーム版「F3_Menu」について以下に


フォーム選択用フォーム「F3_Menu」

kEnt190_D4.jpg

配置的には、
・ヘッダ部に、
 非表示のテキストボックス「txt0」・・・ 条件付き書式用の値(iid)を入れるもの
 非表示のコンボボックス「cbx1」・・・ 用途は「F2_Menu」でのものと同じ
 表示コマンドボタン「btn0」・・・ 元々のフォーム「F2」表示用
・詳細部分に
 iid の文字列表示用テキストボックス「txt1」
  使用可能:いいえ、編集ロック:はい、タブストップ:いいえ
 そのテキストボックスを覆う透明のコマンドボタン「btn1」

帳票フォームとして作っておいて、レコードソースは未設定状態にしておきます。
ADO で、フィールド「iid」「iname」を作って、それをフォームのレコードセットに設定します。
「btn0」がクリックされたら、元々フォーム「F2」を表示する様に、引数は 0 で・・・
「btn1」がクリックされたら、そのレコードの iid を「txt0」に設定しつつ、
 増殖フォーム iid を表示する様に

帳票フォームとして、10件表示できる高さにしています。
( + 100 部分は微調整用)

記述したのは以下
Dim rs As ADODB.Recordset

Private Sub Form_Open(Cancel As Integer)
  If (Len(Nz(Me.OpenArgs)) = 0) Then Cancel = True
End Sub

Private Sub Form_Load()
  Me.InsideHeight = Me.Section(acHeader).Height _
          + Me.Section(acDetail).Height * 10 _
          + 100
End Sub

Public Sub SetMenu(vAry As Variant)
  Dim i As Long

  Me.cbx1.Requery
  If (Not rs Is Nothing) Then
    rs.Close
    Set rs = Nothing
  End If

  Set rs = New ADODB.Recordset
  With rs
    .Fields.Append "iid", adInteger
    .Fields.Append "iname", adVarChar, 30
    .CursorLocation = adUseClient
    .CursorType = adOpenKeyset
    .LockType = adLockOptimistic
    .Open
    For i = 0 To UBound(vAry)
      .AddNew
      rs("iid") = vAry(i)
      Me.cbx1 = vAry(i)
      rs("iname") = Me.cbx1.Column(1)
      .Update
    Next
  End With
  Set Me.Recordset = rs
  Me.txt1.ControlSource = "iname"
  Me.txt0 = Null
  With Me.txt1.FormatConditions
    .Delete
    With .Add(acExpression, , "[txt0]=[iid]")
      .BackColor = RGB(255, 255, 192)
    End With
  End With
  Me.btn0.SetFocus
End Sub

Private Sub btn0_Click()
  Call ShowForm2(0)
End Sub

Private Sub btn1_Click()
  Me.txt0 = Me!iid
  Call ShowForm2(Me!iid)
End Sub

Private Sub Form_Close()
  If (Not rs Is Nothing) Then
    rs.Close
    Set rs = Nothing
  End If
  Call DelForm2
End Sub

 
※ rs("iid") 部分は、.Fields("iid") の方が良かったかも・・・ "iname" 部分も同様に

※ ADO のインメモリレコードセットを作成した後、カレント行を設定していないので、
 必ず最終行が表示されることとなります。
 ただ、増殖を繰り返していくと最終行だけの表示になる事があります。
 (もちろん、スクロールすれば前の行も見れます)
 今回、手抜きで対処していませんが、最終行を含めて10件分表示したければ CurrentSectionTop 等
 GotoPage 操作すれば良いと思います。
 (過去に GoToPage 使った記事が何個かありましたね・・・・ 今回のでは未検証)

※ ADO のインメモリレコードセットで作成した「iid」を参照する時、
 Me!iid
 とします。
 元々レコードソースも設定していなく、動的に作成したものなので・・・
 Me.iid
 とすると
コンパイルエラー:
メソッドまたはデータメンバが見つかりません。
 のエラーになります。

※ この「F3_Menu」は、Access 2000 では動作しません。
 「btn1」をクリックとかしたらエラーになると思います。
 なお、冒頭に記述していましたが、2000 用の mdb を 2007 で動かしてみると正常に機能します。
 動かす時の Access バージョンの違い・・・ ということで・・・

※ そうそう・・・
 テキストボックス「txt1」の設定で、
  使用可能:いいえ、編集ロック:はい、タブストップ:いいえ
 としていました。
  使用可能:いいえ、編集ロック:はい
 としているのなら、「タブストップ:いいえ」 設定は、いらないんじゃ・・・・
  使用可能:いいえ
 だけなら、背景色がグレー(?)
  +編集ロック:はい
 なら、綺麗な背景色も設定できるし・・・ また、発生イベントは取れないね(発生しない?)
 ・・・ にもかかわらず、条件付き書式での条件に該当してしまったら
  フォーカスが入っちゃうし・・・ ダブルクリック等のイベントも発生する様になるし・・・

 ま、今回はコマンドボタンで覆うので、
 「タブストップ:いいえ」にしておけば、フォーカスは入らないんでしょう・・・・?


サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt190_2000.zipkEnt190_2003.zipkEnt190_2007.zip
 サイズ 75,91576,63479,145
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2014/02/03

Category: サンプルかな

TB: --  /  CM: 0

top △

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

top △

コメントの投稿

Secret

top △


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