FC2ブログ

スポンサーサイト 


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

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

リスト文字列をフォームで指定 


標題だけでは何のことやら・・・・

簡単に言えば、部門を管理しているテーブルがあるとします。
何か資料を作った時、送付先として、
部門の一覧表示から、チェックボックスでチェックしたものの羅列を入手したい・・・・
この羅列は、特に履歴として残しておくものでもないので、その場限りで十分・・・・・

今回用意したフォームは、メイン/サブの構成になります。( 左が 2007 / 右が 2003 )
kEnt149_F1  kEnt149_2003

サブ側は、一覧を表示して、チェックボックスを管理する。
メインの方では、何を一覧で表示するとか・・・・区切りを何にするとか・・・・

用意したテーブルは以下
kEnt149_Table

メイン/サブのデザインは以下
kEnt149_D_F1  kEnt149_D_FS

なお、今回の羅列はテキストボックスに表示するようにしていますが、
他のフォームのテキストボックスをダブルクリックした時にフォームを起動し、
文字を取得した時点で、元のテキストボックスに文字列を設定する・・・・・
そういう改修はチョイですね(過去記事に例があったと思います)

また、前記事のコメントで頂いたものを実現するのに、これを改造すれば部分的に楽そうです。
記事後半で、コメントへの記述を追加しています。
急いで記事書いたので、結構端折っているところがあるかも・・・・
 
サブフォーム「FS」を作る

kEnt149_D_FS  kEnt149_FS

過去記事でも、帳票フォームでチェックするものを紹介していました。
その方法の大元は、hatena さんの以下記事を参考にさせていただいたものになります。
 ・非連結のチェックボックスでレコードを選択する

今回の方法は、レコードを特定するものがない・・・・この状況で実現する方法になります。
では、レコードを特定するものに何を使うか・・・・
「 Recordset 内の AbsolutePosition 」を使います。この AbsolutePosition を使用し、
チェックされた・・・・これを、Dictionary で管理します。
チェックが外れた・・・・ Dictionary から AbsolutePosition 情報(キー)を削除します。

チェックボックス / コマンドボタン の関係に変更はありません。
チェックボックスの上に透明なコマンドボタンを配置します。

チェックボックスのコントロールソースに =ShowCheck() を記述
やっている内容は、
Private Function MyRecNo() As Long
  With Me.RecordsetClone
    .Bookmark = Me.Bookmark
    MyRecNo = .AbsolutePosition
  End With
End Function

Private Function ShowCheck() As Boolean
  If (dic Is Nothing) Then Exit Function
  ShowCheck = dic.Exists(MyRecNo)
End Function

コマンドボタンのクリック時に =btnClick() を記述
やっている内容は
Private Function btnClick()
  Dim i As Long

  i = MyRecNo
  If (dic.Exists(i)) Then
    dic.Remove i
  Else
    dic.Item(i) = Null
  End If
  Me.Recalc
End Function
ここのところは関数として作りましたが、btn1_Click() で記述しても・・・・

デザイン上の左横のテキストボックス「txt1」は、起動された時に
得られた Recordset の 0 番目フィールドをVBAで連結・・・・
その上のラベル「lab1」には、同様に 0 番目のフィールド名を表示します。
今回、Recordset が得られていなかったら・・・・という処理は入れていなかったので、
以下内容をレコードソースに指定していました。
SELECT T部門.部門名 FROM T部門 WHERE (((T部門.配布) Is Not Null)) ORDER BY T部門.配布;

上記設定を見てわかるかも・・・・ですが、表示する文字列(0 番目フィールド)は重複OKです。
また、途中でレコードソースを切り替え出来るように・・・・
チェックしたデータを渡せるように・・・・
この部分を関数にして、外出し( Public )しました。

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

Public Sub init()
  With Me.Recordset.Fields(0)
    Me.lab1.Caption = .Name
    Me.txt1.ControlSource = .Name
  End With
  If (dic Is Nothing) Then
    Set dic = CreateObject("Scripting.Dictionary")
  End If
  dic.RemoveAll
  Me.Recalc
End Sub

Public Sub ReInit(sSql As String)
  Me.RecordSource = sSql
  Call init
End Sub

Public Function GetStr(Optional sDLM As String = " ") As String
  Dim sS As String

  sS = ""
  With Me.RecordsetClone
    .MoveFirst
    While (Not .EOF)
      If (dic.Exists(.AbsolutePosition)) Then
        sS = sS & sDLM & .Fields(0)
      End If
      .MoveNext
    Wend
  End With
  GetStr = Mid(sS, Len(sDLM) + 1)
End Function

Private Function MyRecNo() As Long
  With Me.RecordsetClone
    .Bookmark = Me.Bookmark
    MyRecNo = .AbsolutePosition
  End With
End Function

Private Function ShowCheck() As Boolean
  If (dic Is Nothing) Then Exit Function
  ShowCheck = dic.Exists(MyRecNo)
End Function

Private Function btnClick()
  Dim i As Long

  i = MyRecNo
  If (dic.Exists(i)) Then
    dic.Remove i
  Else
    dic.Item(i) = Null
  End If
  Me.Recalc
End Function

Private Sub Form_Load()
  Me.cb1.ControlSource = "=ShowCheck()"
  Me.btn1.OnClick = "=btnClick()"
  Call init
End Sub

Private Sub Form_Close()
  Set dic = Nothing
End Sub

 
※ いつも過去記事で紹介していた、サブフォームとして起動されていなかったら・・・・
  この処理は入れてませんでした。
  単独起動でも、チェックボックスの動きを確認できるかな・・・・ということで


メイン(確認用)フォーム「F1」を作る


これは、上記で作成したフォームをサブフォームとして組み込んで・・・・の確認用です。
単票で非連結のフォームになります。
・上記フォーム「FS」をサブフォームコントロール「FSUB」として組み込んで、
・文字列取得用のコマンドボタン「btn1」
・区切り指定用のテキストボックス「txt1」、得た文字列表示用テキストボックス「txt2」
・チェックのクリア用コマンドボタン「btn2」
・サブフォームに設定するレコードソース切り替え用にオプショングループ「op1」
を配置します。

起動されたら、初期のレコードソースを設定します。
レコードソースを設定する部分は、オプショナルグループに持たせているので、
値設定後、オプショナルグループのクリック時を実行させます。
何を設定するか・・・・これ、メッセージボックスで表示されるので、フォーム起動直後は驚くかも??

操作としては、チェックボックス表示をいろいろ変更し、文字取得のコマンドボタンのクリックで、
チェックされた文字列が区切りに従い、テキストボックス「txt2」に表示されます。

記述した内容は以下
Private Sub btn1_Click()
  Dim sDLM As String

  sDLM = " "
  If (Not IsNull(Me.txt1)) Then sDLM = " " & Me.txt1 & " "
  With Me.txt2
    .Value = Me.FSUB.Form.GetStr(sDLM)
    .SetFocus
  End With
End Sub

Private Sub btn2_Click()
  Call Me.FSUB.Form.init
  Me.txt2 = Null
End Sub

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

Private Sub op1_Click()
  Dim sSql(2) As String
  Dim i As Long

  sSql(0) = "SELECT 部門名 FROM T部門 WHERE 配布 Is Not Null ORDER BY 配布;"
  sSql(1) = "SELECT 部門名 FROM T部門 WHERE 配布 Is Not Null ORDER BY 配布 DESC;"
  sSql(2) = "SELECT 品名 FROM T品名 ORDER BY 品番;"
  i = Me.op1
  MsgBox "以下を設定" & vbCrLf & vbCrLf & sSql(i)
  Call Me.FSUB.Form.ReInit(sSql(i))
  Me.txt2 = Null
End Sub

 

選択する部品として見れば、そこそこ使えると思います。

サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt149_2000.zipkEnt149_2003.zipkEnt149_2007.zip
 サイズ 24,34725,60827,817
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化



【追記】

前記事のコメントにあった、「品目」「食種」の関係を上記サブフォームを使えば・・・ってことで、
※ 前提で、「品目」「食種」の表示内容はテーブルで得られる!!
※ 以下の記述は、登録操作に特化したものになります。(更新等は別途・・・・かな?)

・単に「品目」「食種」を掛け合わせる場合

サブフォームコントロールを2つ作ります「FSUB1」「FSUB2」
そのサブフォームコントロールには、同じフォーム「FS」(上記)を指定しておきます。
フォーム「FS」は、記事内容から以下を変更しておきます。
・フォームのレコードソース部分を空白に
・部分的に以下記述に変更
Public Sub init()
  If (Len(Me.RecordSource) > 0) Then
    With Me.Recordset.Fields(0)
      Me.lab1.Caption = .Name
      Me.txt1.ControlSource = .Name
    End With
  End If
  If (dic Is Nothing) Then
    Set dic = CreateObject("Scripting.Dictionary")
  End If
  dic.RemoveAll
  Me.Recalc
End Sub

で、メインが起動された時、
Call Me.FSUB1.Form.ReInit("SELECT 品目 FROM テーブル名 ORDER BY XX;")
Call Me.FSUB2.Form.ReInit("SELECT 食種 FROM テーブル名 ORDER BY XX;")

で設定しておけば、登録ボタンの処理で、
  Dim sDLM As String
  Dim sAry1() As String
  Dim sAry2() As String
  Dim i As Long, j As Long

  sDLM = " "
  sAry1 = Split(Me.FSUB1.Form.GetStr(sDLM), sDLM)
  If (UBound(sAry1) < 0) Then Exit Sub
  sAry2 = Split(Me.FSUB2.Form.GetStr(sDLM), sDLM)
  If (UBound(sAry2) < 0) Then Exit Sub
  For i = 0 To UBound(sAry1)
    For j = 0 To UBound(sAry2)
      ' ★ sAry1(i) sAry2(j) で掛け合わせが求まる
    Next
  Next
が基本になると思います。
なお、
  If (UBound(sAry1) < 0) Then Exit Sub
の判別はいらないと言えばいらないかも・・・・
(得られた文字列が空文字だったら、Split 後の UBound では -1 になって For は回らない)
後は、SQLを用意しておいて
  Const sSqlBase As String = "INSERT INTO テーブル名(提供日,提供時,品目,食種) VALUES " _
              & "(#{%1}#,'{%2}','{%3}','{%4}');"

  Dim sSql As String

  sSql = sSqlBase
  sSql = Replace(sSql, "{%1}", Me.提供日)
  sSql = Replace(sSql, "{%2}", Me.提供時)
  sSql = Replace(sSql, "{%3}", sAry1(i))
  sSql = Replace(sSql, "{%4}", sAry2(j))
  CurrentProject.Connection.Execute sSql
みたいな感じで、レコードを追加していく・・・・ Recordset を使っても良いかも
※ テーブル内の「ID」は、オートナンバと解釈

処理終わったら、一覧表示用のサブフォームを再クエリすれば・・・・・
(ここで、フォームを構成するコントロールは、前記事コメントを参照してください)


・「品目」変更で「食種」表示を切り替える場合

「品目」部分はリストボックスにしておきます。
動き的には、上記の応用なので・・・・
リストボックスがクリックされて変更されたら、それ用のSQLを食種サブフォームに設定します。
登録ボタンが押されたら、食種のリストを求めて、Split したものと、リストボックスの内容で
INSERT 文を作って・・・・・

そんなに変更が多いものではないですね・・・・
選択するのをコロコロ切り替えるには、コンボボックスよりリストボックス?
コンボボックスでも、処理に変更は無いですね・・・・


・実は文字列ではなく ID で登録していた場合

「品目」「食種」部分は、実際には「品目ID」「品目」とか「食種ID」「食種」となっている
テーブルを参照し、「ID」の方を登録するものだった場合・・・・

これも記事で書いたものをチョッと変更すればすぐにできます。
フォーム「FS」への変更ですが、
・上記で記述した、レコードソースが設定されてなかったら・・・部分と
・文字列を渡す部分を以下に変更します
Public Sub init()
  If (Len(Me.RecordSource) > 0) Then
    With Me.Recordset.Fields(0)
      Me.lab1.Caption = .Name
      Me.txt1.ControlSource = .Name
    End With
  End If
  If (dic Is Nothing) Then
    Set dic = CreateObject("Scripting.Dictionary")
  End If
  dic.RemoveAll
  Me.Recalc
End Sub

Public Function GetStr(Optional iNum As Long = 0, Optional sDLM As String = " ") As String
  Dim sS As String

  On Error Resume Next
  sS = ""
  With Me.RecordsetClone
    .MoveFirst
    While (Not .EOF)
      If (dic.Exists(.AbsolutePosition)) Then
        sS = sS & sDLM & .Fields(iNum)
      End If
      .MoveNext
    Wend
  End With
  GetStr = Mid(sS, Len(sDLM) + 1)
End Function

文字列を渡す時、フィールドの何個目を頂戴・・・・この指定を追加します。
省略時は、 0 番目・・・
実際に無い何番目・・・・これを指定された時のエラーを無視する様にしておきます。

メインの方で指定する場合は、
Call Me.FSUB1.Form.ReInit("SELECT 品目, 品目ID FROM テーブル名 ORDER BY XX;")

とします。
あくまで、表示するフィールドは1つ目・・・
で、文字列を得る時に
  sAry1 = Split(Me.FSUB1.Form.GetStr(1,sDLM), sDLM)

とすれば、「ID」側が得られるという事になります。
もちろん INSERT のところでは、文字列から数値に代わるので、sSqlBase の記述を見直します。


※ 上記の例では、常に追加する処理となっているので、既に登録していたら・・・・等、盛り込む?
以下、雰囲気で・・・・(追加した部分は、全部未検証ですけど・・・)

  sDLM = " "
  sAry1 = Split(Me.FSUB1.Form.GetStr(sDLM), sDLM)
  If (UBound(sAry1) < 0) Then Exit Sub
  sAry2 = Split(Me.FSUB2.Form.GetStr(sDLM), sDLM)
  If (UBound(sAry2) < 0) Then Exit Sub
  For i = 0 To UBound(sAry1)
    For j = 0 To UBound(sAry2)
      With Me.FSUB3.Form.RecordsetClone ' ★ 一覧表示用に対して
        .FindFirst "品目='" & sAry1(i) & "' AND 食種='" & sAry2(j) & "'"
        If (.NoMatch) Then
          ' ★★ 無かったので追加する処理
        End If
      End With
    Next
  Next
「品目」「食種」が、文字列の時になりますが・・・・

動かなかったら、ごめんなさいです。


こんな感じで、どうでしょう・・・・
関連記事

2013/03/06

Category: サンプルかな

TB: --  /  CM: 0

top △

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

top △

コメントの投稿

Secret

top △


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