スポンサーサイト 


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

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

検索用途コンボの4階層連携 その2 


前記事「検索用途コンボの4階層連携」について記述していました。
元は、仕様・環境がわからないものに回答したのがベースになっていたのですが、
どうも同じ方が環境を少し具体的にしたもので質問されていたようです。
http://hatena-access.progoo.com/bbs/hatena-access_tree_pr_2961.html」ですが・・・
そこで、提示のあった Excel ファイルから

kEnt199.jpg

・読み込みながらテーブル分割

kEnt199_1.jpg

・Excel ファイルを1つのテーブルにインポート後、1つのテーブルを見ながらコンボ連携

kEnt199_2.jpg

というものを作成し回答時に添付したわけですが・・・・
上記2つの方法では、どうしてもコンボの4階層連携にはならなかったのです。
というのは、
「勘定科目コード」の説明・名称が「勘定科目」なら、この2つがペアでコンボの表示は1つ。
同様に「分類コード(機材番号)」と「分類項目」がペアでコンボの表示は1つ・・・
と、考えていたんですね

そこで、今回の追加サンプルとして、1つのテーブルを見ながら
「勘定科目」「勘定科目コード」「分類項目」「分類コード(機材番号)」
「コード(機材番号)」「枝番(機材番号)」の6つを、コンボ6つで選べるように・・・
なお、この選ぶ時の動きはコンボ同士を連携させるのはもちろんですが
・操作順はどこからでも
・順序良く徐々に絞り込んでいく
2通りを・・・

今回のサンプルファイルには、
・前記事分+サンプルのフォームとして作っていなかった後半記述のフォーム「F_T52」
・Excel ファイルを読み込みつつテーブル分割(標準モジュール:Module1 使用)
 テーブル「T1」「T1A」「T1B」「T1C」「T1D」とフォーム「F_T1」
・Excel ファイルを1つのテーブルにインポート「T_Excel」
 その確認用フォーム「F_Excel」
※ ここまでの内容が以下回答に添付したものと同じ
 「http://hatena-access.progoo.com/bbs/hatena-access_tree_pr_2961.html
・1つのテーブル「T_Excel」を対象に、6コンボ連携
 (操作順なし:フォーム「F_Excel2」)
 (操作順あり:フォーム「F_Excel3」)
・次の記事用
 標準モジュール:「Module2」「Module3」
 テーブル「T圏」「T地方1」「T地方2」「T都道府県」の4つ
※ 取込用 Excel ファイル kEnt199.xls
 Sheet1:本記事用 (提示あったものを使わせて頂きました)
 Sheet2:次の記事用
 
まずは前回記事から追加していったものを順に記述していきます。

Excel ファイルから読み込みながらテーブル展開

kEnt199.jpg

Excel ファイルを眺めていると、
コードと名称・・・ コードと名称・・・ でテーブル分割した方が良さそうということで、

kEnt199_1.jpg

のような構成に・・・
この Excel ファイルを読み込みながらテーブル分割する記述を、標準モジュール:Module1 に

Public Sub DataMake()
  Dim oApp As Object, r As Object
  Dim rs() As ADODB.Recordset
  Dim rsM As New ADODB.Recordset
  Dim vA As Variant
  Dim vItem As Variant
  Dim sSql As String, sS1 As String, sS2 As String
  Dim iRow As Long, iCol() As Long
  Dim i As Long, j As Long
  Const CFILE As String = "\kEnt199.xls"
  Const CFLD As String = "重量(kg),単位(損料),損料(円)(損料),損料区分(損料)" _
        & ",滅失価格(円)(損料),保有数H226運用計画表,図面情報"
  Const xlWhole = 1

  vA = Array( _
      Array("T1A", "勘定科目コード", "勘定科目"), _
      Array("T1B", "分類コード(機材番号)", "分類項目"), _
      Array("T1C", "コード(機材番号)", "枝番(機材番号)") _
    )

  Set oApp = CreateObject("Excel.Application")
  oApp.Visible = True
  With oApp
    .Workbooks.Open CurrentProject.Path & CFILE, ReadOnly:=True
    With .Worksheets("Sheet1")
      For i = 0 To UBound(vA)
        For j = 1 To 2
          Set r = .Rows(1).Find(vA(i)(j), LookAt:=xlWhole)
          If (r Is Nothing) Then GoTo INNER_ERROUT
          vA(i)(j) = r.Column
        Next
      Next
      vItem = Split(CFLD, ",")
      ReDim iCol(UBound(vItem))
      For i = 0 To UBound(vItem)
        Set r = .Rows(1).Find(vItem(i), LookAt:=xlWhole)
        If (r Is Nothing) Then GoTo INNER_ERROUT
        iCol(i) = r.Column
      Next

      ReDim rs(UBound(vA))
      For i = 0 To UBound(vA)
        sSql = "DELETE * FROM " & vA(i)(0) & ";"
        CurrentProject.Connection.Execute sSql
        Set rs(i) = New ADODB.Recordset
        rs(i).Open vA(i)(0), CurrentProject.Connection, adOpenStatic, adLockOptimistic
      Next
      sSql = "DELETE * FROM T1;"
      CurrentProject.Connection.Execute sSql
      rsM.Open "T1", CurrentProject.Connection, adOpenStatic, adLockOptimistic

      iRow = 2
      While (.Cells(iRow, 1).Value <> "")
        For i = 0 To UBound(vA)
          sS1 = .Cells(iRow, vA(i)(1)).Value
          sS2 = .Cells(iRow, vA(i)(2)).Value
          rs(i).Filter = "cd = '" & sS1 & "' AND 名称 = '" & sS2 & "'"

          If (i > 0) Then ' ★~
            Do While (Not rs(i).EOF)
              If (rs(i)("id" & i) = rs(i - 1)("id")) Then Exit Do
              rs(i).MoveNext
            Loop
          End If ' ~★


          If (rs(i).EOF) Then
            rs(i).AddNew
            rs(i)("id") = Nz(DMax("id", vA(i)(0)), 0) + 1
            rs(i)("cd") = sS1
            rs(i)("名称") = sS2
            If (i > 0) Then rs(i)("id" & i) = rs(i - 1)("id")
            rs(i).Update
          End If
        Next
        rsM.AddNew
        For i = 0 To UBound(vA)
          If (Not rs(i).EOF) Then rsM("id" & i + 1) = rs(i)("id")
        Next
        For i = 0 To UBound(vItem)
          rsM(vItem(i)) = .Cells(iRow, iCol(i)).Value
        Next
        rsM.Update
        iRow = iRow + 1
      Wend
      rsM.Close
      For i = 0 To UBound(vA)
        rs(i).Close
        Set rs(i) = Nothing
      Next
    End With
INNER_ERROUT:
    .Workbooks.Close
  End With
  oApp.Quit
  Set oApp = Nothing
End Sub

 
※ 上記 ★~ ~★ は、回答時から追加変更しています。というのは、
 テーブル「T1C」を作り込む時に、「T1A」「T1B」順で辿ってきたにもかかわらず、
 「コード(機材番号)」「枝番(機材番号)」の組合せが重複して出現する様なので、
 重複しても辿ってきたルートが違えば登録する様に・・・・
 まっ、回答ではデータを作るのが目的ではなくコンボの連携が主なので、ソコソコデータが出来たから良いか
 一応確認用で、クエリ「Q_T1C」を作っています。
 表示してみると、同じ「cd」「名称」が「id2」を変えながら出現していると思います。
 「id2」が異なる・・・・ つまり辿ってきたルートが違うことに・・・

※ 本来 Excel の可視表示は不要ですが、確認用で作っているので、Visible = True してます。

  vA = Array( _
      Array("T1A", "勘定科目コード", "勘定科目"), _
      Array("T1B", "分類コード(機材番号)", "分類項目"), _
      Array("T1C", "コード(機材番号)", "枝番(機材番号)") _
    )
の部分、
      Array("T1A", "勘定科目コード", "勘定科目"), _
は、テーブル「T1A」の
フィールド「cd」に Excel の項目「勘定科目コード」を
フィールド「名称」に Excel の項目「勘定科目」を設定しますよ・・・という定義になります。

    With .Worksheets("Sheet1")
      For i = 0 To UBound(vA)
        For j = 1 To 2
          Set r = .Rows(1).Find(vA(i)(j), LookAt:=xlWhole)
          If (r Is Nothing) Then GoTo INNER_ERROUT
          vA(i)(j) = r.Column
        Next
      Next
は、Excel ファイルオープン後、Sheet1 を対象に1行目を検索します。
検索文字列は、定義した上記項目について・・・・
見つかったら、項目名部分を 列(数値)で上書きします。
(その項目がどの列にあるかを求めた後、項目の文字列はいらなくなるので)

本体用のテーブル「T1」の項目についても、列を求めておきます。
(今回、フィールド名=Excel の項目名としていました)
  Const CFLD As String = "重量(kg),単位(損料),損料(円)(損料),損料区分(損料)" _
        & ",滅失価格(円)(損料),保有数H226運用計画表,図面情報"

      vItem = Split(CFLD, ",")
      ReDim iCol(UBound(vItem))
      For i = 0 To UBound(vItem)
        Set r = .Rows(1).Find(vItem(i), LookAt:=xlWhole)
        If (r Is Nothing) Then GoTo INNER_ERROUT
        iCol(i) = r.Column
      Next

レコードセットを配列で扱うようにし、各テーブルを初期化しておきます。
      ReDim rs(UBound(vA))
      For i = 0 To UBound(vA)
        sSql = "DELETE * FROM " & vA(i)(0) & ";"
        CurrentProject.Connection.Execute sSql
        Set rs(i) = New ADODB.Recordset
        rs(i).Open vA(i)(0), CurrentProject.Connection, adOpenStatic, adLockOptimistic
      Next
      sSql = "DELETE * FROM T1;"
      CurrentProject.Connection.Execute sSql
      rsM.Open "T1", CurrentProject.Connection, adOpenStatic, adLockOptimistic

2行目から順次解釈していくのですが、各テーブルの「cd」「名称」はテキスト型です。
Excel から「cd」「名称」用のデータを入手し、そのテーブル内にあるか確認します。
あった場合、2つ目以降のテーブルを操作していた場合、
辿って来た親のデータを保持しているか「idX」(X は数字)と前のテーブルの「id」を比較します。
既に持っているのなら Do を抜けるだけです。
辿ってきた所に無ければ、テーブルに登録していきます。
各テーブルの「id」は、自分で1~ 採番するように決めたので DMax で求めて・・・
辿ってきた階層の親「id」を登録します。
この処理によって、各レコードセットのカレント値が本テーブル「T1」に登録したいものになります。
      iRow = 2
      While (.Cells(iRow, 1).Value <> "")
        For i = 0 To UBound(vA)
          sS1 = .Cells(iRow, vA(i)(1)).Value
          sS2 = .Cells(iRow, vA(i)(2)).Value
          rs(i).Filter = "cd = '" & sS1 & "' AND 名称 = '" & sS2 & "'"

          If (i > 0) Then ' ★~
            Do While (Not rs(i).EOF)
              If (rs(i)("id" & i) = rs(i - 1)("id")) Then Exit Do
              rs(i).MoveNext
            Loop
          End If ' ~★


          If (rs(i).EOF) Then
            rs(i).AddNew
            rs(i)("id") = Nz(DMax("id", vA(i)(0)), 0) + 1
            rs(i)("cd") = sS1
            rs(i)("名称") = sS2
            If (i > 0) Then rs(i)("id" & i) = rs(i - 1)("id")
            rs(i).Update
          End If
        Next

本テーブル「T1」用の処理では
        rsM.AddNew
        For i = 0 To UBound(vA)
          If (Not rs(i).EOF) Then rsM("id" & i + 1) = rs(i)("id")
        Next
        For i = 0 To UBound(vItem)
          rsM(vItem(i)) = .Cells(iRow, iCol(i)).Value
        Next
        rsM.Update
と、テーブル分割した各「id」と本テーブル用の項目を Excel から取り込んで終わり・・・
これを最終行まで繰り返します。
 While (.Cells(iRow, 1).Value <> "")
としていたので A列で判定・・・

このテーブル群での、コンボ連携を確認するフォームは「F_T1」
本テーブル「T1」には、テーブル分割したところ以外にデータが入っていないので、フォーム「F_T52」を流用

コンボ「cbx1」の設定
 値集合ソース: SELECT id, 名称, cd FROM T1A ORDER BY cd;
 列数: 3
 連結列: 1
 列幅: 0cm;2cm;2cm (「id」は見せなくて良いので)
 リスト幅: 4cm
 入力チェック: はい

コンボ「cbx2」の設定
 値集合ソース: SELECT id, id1, 名称, cd FROM T1B WHERE id1=[cbx1] ORDER BY cd;
 列数: 4
 連結列: 1
 列幅: 0cm;0cm;2cm;2cm (「id」は見せなくて良いので)
 リスト幅: 4cm
 入力チェック: はい

コンボ「cbx3」の設定
 値集合ソース: SELECT id, id2, 名称, cd FROM T1C WHERE id2=[cbx2] ORDER BY cd;
 列数: 4
 連結列: 1
 列幅: 0cm;0cm;2cm;2cm (「id」は見せなくて良いので)
 リスト幅: 4cm
 入力チェック: はい

コンボ「cbx4」の設定(参照先のテーブル「T1D」は空なので、設定はいらないけど・・・)
 値集合ソース: SELECT id, id3, 名称, cd FROM T1D WHERE id3=[cbx3] ORDER BY cd;
 列数: 4
 連結列: 1
 列幅: 0cm;0cm;2cm;2cm (「id」は見せなくて良いので)
 リスト幅: 4cm
 入力チェック: はい

フォーム「F_T1」のVBA記述で、フォーム「F_T52」から変更した部分は、
  vCtl = Array( _
        Array("cbx1", "id1 = ", ""), _
        Array("cbx2", "id2 = ", ""), _
        Array("cbx3", "id3 = ", ""), _
        Array("cbx4", "id4 = ", "") _
      )
だけです。
また、上記は「cbx4」自体意味を持たないので、以下の定義でもOK
  vCtl = Array( _
        Array("cbx1", "id1 = ", ""), _
        Array("cbx2", "id2 = ", ""), _
        Array("cbx3", "id3 = ", "") _
      )

一応これで確認すると、
同じコード・名称でも辿り方によっては異なる「id」で登録していたのでソコソコ・・・・???

ただ、これでは4階層にはならないかな・・・・
次の方法も4階層にはなりませんが、違う方法で・・・・
元々の Excel ファイル情報を1つのテーブルに無加工で取り込む・・・・
テーブル「T_Excel」に手動でインポート・・・

kEnt199_2.jpg

そのテーブルを元に、コード・名称・・・の扱いを引き継いだものがフォーム「F_Excel」
このフォームの作成は手間でしたね・・・
何故って・・・ フィールド名に "(" とか ")" を使っていたので、フォームウィザードが動かない・・・

Access データベースでの作業時に使用すべきでない特殊文字
http://support.microsoft.com/kb/826763/ja

とか読んで快適に使っていきたいものですね・・・・
といいつつ、今回はそのまま強硬します。
ウィザードを使用せずに、
テキストボックス配置・レコードソース設定後、コントロールソースを割当てていきます。
4つのコンボは、他フォームからコピー

テーブル1つを対象に処理する様に変更していきます。

コンボ「cbx1」の設定
 値集合ソース: SELECT DISTINCT 勘定科目コード, 勘定科目 FROM T_Excel ORDER BY 勘定科目コード;
 列数: 2
 連結列: 1
 列幅: 2cm;2cm
 リスト幅: 6cm
 入力チェック: はい

コンボ「cbx2」の設定
 値集合ソース: SELECT DISTINCT [分類コード(機材番号)], 分類項目 FROM T_Excel WHERE 勘定科目コード=[cbx1] ORDER BY [分類コード(機材番号)];
 列数: 2
 連結列: 1
 列幅: 2cm;2cm
 リスト幅: 6cm
 入力チェック: はい

コンボ「cbx3」の設定
 値集合ソース: SELECT DISTINCT [コード(機材番号)], [枝番(機材番号)] FROM T_Excel WHERE [分類コード(機材番号)]=[cbx2] ORDER BY [コード(機材番号)];
 列数: 2
 連結列: 1
 列幅: 2cm;2cm
 リスト幅: 6cm
 入力チェック: はい

このフォームのVBA記述は、フォーム「F_52」から流用し、変更したのは以下部分。
  vCtl = Array( _
        Array("cbx1", "勘定科目コード = '", "'"), _
        Array("cbx2", "[分類コード(機材番号)] = '", "'"), _
        Array("cbx3", "[コード(機材番号)] = '", "'") _
      )

これでソコソコ動きはしますが、「F_T1」とは若干動きが異なりますね・・・
「cbx1」で「工具・器具」を選んでも、「cbx2」に「仮設材料」とか候補が出てきますね・・・
これは、同じコードが割り当てられているから・・・・
でも、「F_T1」では区別されてますね・・・・ コード・名称のペアで id を振っていたからですね・・・

そこで、コード・名称とペアでコンボ選択するのではなく、今までのペアを解消し6つのコンボで・・・
まずは、6つのコンボを操作順関係なく連携(候補表示を順次絞り込み)するフォーム「F_Excel2」

kEnt199_3.jpg

フォーム「F_Excel」を「F_Excel2」名でコピーし、コンボを6つ「cbx1」~「cbx6」配置します。
各コンボの値集合ソースを設定していきますが、ベースとなる記述は以下になります。

  SELECT DISTINCT XXXXXX FROM T_Excel WHERE
  IIF(IsNull([cbx1]), True, 勘定科目 = [cbx1]) AND
  IIF(IsNull([cbx2]), True, 勘定科目コード = [cbx2]) AND
  IIF(IsNull([cbx3]), True, 分類項目 = [cbx3]) AND
  IIF(IsNull([cbx4]), True, [分類コード(機材番号)] = [cbx4]) AND
  IIF(IsNull([cbx5]), True, [コード(機材番号)] = [cbx5]) AND
  IIF(IsNull([cbx6]), True, [枝番(機材番号)] = [cbx6])
  ORDER BY XXXXXX;

 上記がコンボ[cbx1]~[cbx6]の値集合ソースに設定するベース
 [cbx2]を例にすると IIF の [cbx2] 部分を削除し、
 [cbx2]で判別していたものを XXXXXX に記述する(以下)
  SELECT DISTINCT 勘定科目コード FROM T_Excel WHERE
  IIF(IsNull([cbx1]), True, 勘定科目 = [cbx1]) AND
  IIF(IsNull([cbx3]), True, 分類項目 = [cbx3]) AND
  IIF(IsNull([cbx4]), True, [分類コード(機材番号)] = [cbx4]) AND
  IIF(IsNull([cbx5]), True, [コード(機材番号)] = [cbx5]) AND
  IIF(IsNull([cbx6]), True, [枝番(機材番号)] = [cbx6])
  ORDER BY 勘定科目コード;

値集合ソース以外の設定は共通で、
 列数: 1
 連結列: 1
 列幅: 3cm
 リスト幅: 自動
 入力チェック: はい

で、この設定を生かす為の VBA 記述は以下
Dim vCtl As Variant

Private Sub Form_Load()
  Dim i As Long

'  SELECT DISTINCT XXXXXX FROM T_Excel WHERE
'  IIF(IsNull([cbx1]), True, 勘定科目 = [cbx1]) AND
'  IIF(IsNull([cbx2]), True, 勘定科目コード = [cbx2]) AND
'  IIF(IsNull([cbx3]), True, 分類項目 = [cbx3]) AND
'  IIF(IsNull([cbx4]), True, [分類コード(機材番号)] = [cbx4]) AND
'  IIF(IsNull([cbx5]), True, [コード(機材番号)] = [cbx5]) AND
'  IIF(IsNull([cbx6]), True, [枝番(機材番号)] = [cbx6])
'  ORDER BY XXXXXX;

' 上記がコンボ[cbx1]~[cbx6]の値集合ソースに設定するベース
' [cbx2]を例にすると IIF の [cbx2] 部分を削除し、
' [cbx2]で判別していたものを XXXXXX に記述する(以下)

'  SELECT DISTINCT 勘定科目コード FROM T_Excel WHERE
'  IIF(IsNull([cbx1]), True, 勘定科目 = [cbx1]) AND
'  IIF(IsNull([cbx3]), True, 分類項目 = [cbx3]) AND
'  IIF(IsNull([cbx4]), True, [分類コード(機材番号)] = [cbx4]) AND
'  IIF(IsNull([cbx5]), True, [コード(機材番号)] = [cbx5]) AND
'  IIF(IsNull([cbx6]), True, [枝番(機材番号)] = [cbx6])
'  ORDER BY 勘定科目コード;

  vCtl = Array( _
        Array("cbx1", "勘定科目 = '", "'"), _
        Array("cbx2", "勘定科目コード = '", "'"), _
        Array("cbx3", "分類項目 = '", "'"), _
        Array("cbx4", "[分類コード(機材番号)] = '", "'"), _
        Array("cbx5", "[コード(機材番号)] = '", "'"), _
        Array("cbx6", "[枝番(機材番号)] = '", "'") _
      )
  For i = 0 To UBound(vCtl)
    With Me(vCtl(i)(0))
      .OnEnter = "=EnterCheck()"
      .AfterUpdate = "=UpdateCheck()"
    End With
  Next
End Sub

Private Function EnterCheck()
  With Me.ActiveControl
    .Requery
    .Dropdown
  End With
End Function

Private Function UpdateCheck()
  Dim sFilter As String
  Dim i As Long

  sFilter = ""
  For i = 0 To UBound(vCtl)
    If (Not IsNull(Me(vCtl(i)(0)))) Then
      sFilter = sFilter & " AND " _
        & vCtl(i)(1) & Me(vCtl(i)(0)) & vCtl(i)(2)
    End If
  Next
  Me.Filter = Mid(sFilter, 6)
  Me.FilterOn = Len(Me.Filter) > 0
End Function

 
今回のインポートしたテーブル構成では、Filter 対象フィールドは全てテキスト型・・・
もし、数値型とかの場合は、定義部分で ' ' でコンボの値を囲まない様にすれば良いですね・・・

さて、これで操作順は不問になりますが、
選択したものを変更しようとした場合、操作が面倒・・・・ 
表示候補を大きく絞り込んでいるコンボボックスを特定して、そのコンボ表示を消去しないと
他コンボの候補表示が広がらない・・・
(ここ・・・ 記述していて表現しきれていない?ような・・・)

「cbx4」とか「cbx5」で選んでしまうと、他コンボの候補表示が少なくなります。
この状態で「cbx1」で別のものを選びたい・・・
「cbx4」「cbx5」を一旦削除しないと「cbx1」で他を選べない・・・

どうにか読み取ってください(実際に「F_Excel2」を触ってみてください)
まっ、これへの対処は、全コンボを初期化するボタンとか配置すれば楽ですけど・・・


・・・・操作が面倒なので、「cbx1」~ 順に絞り込みさせようというのがフォーム「F_Excel3」

kEnt199_4.jpg

フォーム「F_Excel2」を「F_Excel3」名でコピー後、コンボの設定・VBA記述を変更していきます。
(デザイン上の変更はありません)
コンボの動きとして、順序良く絞り込んでいくものになります。

各コンボの値集合ソースを設定していきますが、ベースとなる記述は以下になります。
  SELECT DISTINCT XXXXXX FROM T_Excel WHERE
  勘定科目 = [cbx1] AND
  勘定科目コード = [cbx2] AND
  分類項目 = [cbx3] AND
  [分類コード(機材番号)] = [cbx4] AND
  [コード(機材番号)] = [cbx5] AND
  ORDER BY XXXXXX;

上記がコンボ[cbx1]~[cbx6]の値集合ソースに設定するベース
[cbx2]を例にすると WHERE の [cbx2] 部分以降をを削除し、
[cbx2]で判別していたものを XXXXXX に記述する(以下)
  SELECT DISTINCT 勘定科目コード FROM T_Excel WHERE
  勘定科目 = [cbx1]
  ORDER BY 勘定科目コード;
また、[cbx3]を例にすると
  SELECT DISTINCT 分類項目 FROM T_Excel WHERE
  勘定科目 = [cbx1] AND
  勘定科目コード = [cbx2]
  ORDER BY 分類項目;

テーブルが分割されていた場合は、1つ上位のテーブルを参照するものがあったのですが、
1つのテーブルではそれがないので、前のコンボの選択状態を1つ1つ条件設定するようにします。

VBA の記述は・・・ というと、フォーム「F_T52」での定義部分を以下に変更しただけ
  vCtl = Array( _
        Array("cbx1", "勘定科目 = '", "'"), _
        Array("cbx2", "勘定科目コード = '", "'"), _
        Array("cbx3", "分類項目 = '", "'"), _
        Array("cbx4", "[分類コード(機材番号)] = '", "'"), _
        Array("cbx5", "[コード(機材番号)] = '", "'"), _
        Array("cbx6", "[枝番(機材番号)] = '", "'") _
      )

上記定義は、コンボ操作順不問の「F_Excel2」と同じですね。
異なるのは、コンボの値集合ソース部分と、「フォーカス取得時」「更新後処理」のやり方だけ・・・

最終的にはコンボの6連携になりましたね。
4連 → 6連変更は苦じゃないですね・・・ 定義部分を変えるだけ・・・
(増やした分、コンボの値集合ソースを設定する必要はありますけどね)

さて、サンプル上では動いてますが、実際に組み込むとどうなるんでしょうか・・・
エラーが起きたら、まず、データの型確認ですかね・・・
値集合ソース部分では、型がどうの・・・ 言われるような記述はしていないですね。
後は、定義部分・・・ Filter しようとしているものは全てテキスト型でテーブル作ったので、
' ' で囲むようにしていますが、数値型で作っていたのなら ' ' で囲まない様にすれば良いし・・・
今回の例にはないけど、日付型なら # # で囲むように変更すれば良いですね・・・

検索用途のコンボ連携はこんな感じで作れるかと思います。
入力時に連携しながら・・・ なら、見せる用途のコンボの下に上記コンボ群を隠しておけば・・・


次回記事予告)

今回のサンプルファイルに入れていますが、
Excel からデータを取り込む際、テーブル分割しながら・・・ を、汎用的にしたいかな・・・
どの様な状態で取り込みたいのか定義して・・・ それを、ハイって与える・・・
Excel ファイルの Sheet2 を Module2 のもので取り込んでみる。
汎用化しようか・・・ Module3 のもので、Sheet2 / Sheet1 を定義を変えただけで取り込んでみる。
(Sheet1 の内容は今回のデータになります)

取込元となる Excel ファイル「kEnt199.xls」を同梱しています。

サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt199_2000.zipkEnt199_2003.zipkEnt199_2007.zip
 サイズ 253,430255,336264,204
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2014/07/12

Category: サンプルかな

TB: --  /  CM: 0

top △

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

top △

コメントの投稿

Secret

top △


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