スポンサーサイト 


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

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

帳票 + 3つのコンボ変則連携 + α 


標題変更: 帳票 + 3つのコンボ連携 + α → 帳票 + 3つのコンボ変則連携 + α

記事化が、ずっと、ず~っと延び延びになっていたものです。

帳票フォームになりますが・・・(画面が結構ちらつくので・・・)
やってみた(レベル)という事に・・・

基本的なテーブルは4つで、リレーションシップの雰囲気(実際には設定していませんが)は
kEnt150_Table  kEnt150_R
となってます。
これを元に、帳票フォームを組み立てると、見た目
kEnt150_F  kEnt150
になりますが、「コード」「業種」「業態」部分を連携した操作に・・・・
「業種」を設定すれば、他の「コード」「業態」ではその「業種」に絞り込んだ表示に・・・
帳票フォームなので、他レコードの表示に影響がない様にコントロールを重ねる事をします。
  過去にも記事にしてたかな・・・・重ねる
今回は3段重ねあり・・・・で
kEnt150_D  kEnt150_FI

+α として、Excel 1シートに、複数の結果をエクスポートするには・・・・
エクスポートもどきになるのですが、割り当てている業種ごとに並べて出力しましょうか・・・
kEnt150_Excel  kEnt150_Excel1  kEnt150_Excel2
 
テーブルを作る

kEnt150_Table  kEnt150_R
「**ID」部分は、全てオートナンバにしてみました。

サンプルデータを作るのは「Module1」に以下を用意しました。
Public Sub MakeTableData()
  Dim cn As ADODB.Connection
  Dim rs As New ADODB.Recordset
  Dim rs1 As New ADODB.Recordset
  Dim rs2 As New ADODB.Recordset
  Dim iMojiBase As Integer
  Dim i As Long, j As Long, k As Long
  Dim sS As String
  Dim iAry() As Long

  Set cn = CurrentProject.Connection
  cn.Execute "DELETE * FROM T企業;"
  cn.Execute "DELETE * FROM T業種一覧;"
  cn.Execute "DELETE * FROM T業種;"
  cn.Execute "DELETE * FROM T業態;"

  rs.Open "T業種一覧", cn, adOpenKeyset, adLockPessimistic
  rs1.Open "T業種", cn, adOpenKeyset, adLockOptimistic
  rs2.Open "T業態", cn, adOpenKeyset, adLockOptimistic

  iMojiBase = Asc("a")
  For i = 0 To 23
    sS = ""
    For j = 1 To 3
      sS = sS & Chr(iMojiBase + i + j - 1)
    Next
    rs1.AddNew
    rs1(1) = sS
    rs1.Update
  Next
  iMojiBase = Asc("A")
  For i = 0 To 25
    sS = ""
    For j = 1 To 5
      sS = sS & Chr(iMojiBase + i)
    Next
    rs2.AddNew
    rs2(1) = sS
    rs2.Update
  Next

  Randomize
  ReDim iAry(1 To rs1.AbsolutePosition)
  rs2.MoveFirst
  While (Not rs2.EOF)
    If (Int(1000 * Rnd()) > 500) Then
      For i = 1 To UBound(iAry)
        iAry(i) = i
      Next
      For i = 0 To Int(5 * Rnd())
        j = Int((UBound(iAry) - i) * Rnd()) + 1
        rs1.AbsolutePosition = iAry(j)
        iAry(j) = iAry(UBound(iAry) - i)
        rs.AddNew
        rs(1) = rs1(0)
        rs(2) = rs2(0)
        rs.Update
      Next
    End If
    rs2.MoveNext
  Wend
  rs1.Close
  rs2.Close

  k = rs.AbsolutePosition
  iMojiBase = Asc("A")
  rs1.Open "T企業", cn, adOpenForwardOnly, adLockOptimistic
  For i = 1 To 20
    rs.AbsolutePosition = Int(k * Rnd()) + 1
    sS = ""
    For j = 0 To Int(8 * Rnd())
      sS = sS & Chr(iMojiBase + Int(26 * Rnd()))
    Next
    rs1.AddNew
    rs1(1) = sS
    rs1(2) = rs(0)
    rs1.Update
  Next

  rs1.Close
  rs.Close
  Set cn = Nothing
End Sub

 
業種は、連続した英小文字(3文字)
業態は、同じ英大文字(5文字)
    sS = ""
    For j = 1 To 5
      sS = sS & Chr(iMojiBase + i)
    Next
部分は、
    sS = String(5, iMojiBase + i)
が良かったかも・・・
結果は同じになります。

で、これらを使って、「T業種一覧」をソコソコ作っておいて、「T企業」もソコソコに・・・
サンプルデータはこんな感じで、ソコソコに・・・・

「T業種一覧」の各IDでは、元テーブルをコンボボックスでルックアップする様に設定しておきます。
例えば、「業種ID」では、
値集合タイプ: テーブル/クエリ
値集合ソース: T業種
連結列: 1
列数:  2
列幅: 0cm;3cm (IDではなく、業種を見せるように)
入力チェック: はい

また、「T企業」の「コード」部分では、
値集合タイプ: テーブル/クエリ
値集合ソース: SELECT T業種一覧.コード, T業種.業種, T業態.業態 FROM
        (T業種一覧 INNER JOIN T業種 ON T業種一覧.業種ID=T業種.業種ID)
        INNER JOIN T業態 ON T業種一覧.業態ID=T業態.業態ID;
連結列: 1
列数:  3
列見出し: はい
列幅: 1.501cm;2cm;2cm (コードを見せるように:Dropdown 時には全部見せるように )
入力チェック: はい


フォームを作る

フォームウィザードを使った方が(大まかなものを)簡単に作れるので、
以下の様な感じで、仮のクエリ「Q1」を作って、それを元にフォームを作ります。

kEnt150_F

フォームが出来上がったら、レコードソース部分をクエリ「Q1」のSQLに置換え、クエリ「Q1」を削除します。(私の場合は、こんな感じの手順でするという事で・・・・)
この手順・・・、どこに利点があるのか・・・考えてみてください。(・・・ ないかも)

※ 上記クエリを使ってフォームを作ると、「業種」「業態」部分は ID 付きになるので、
  ラベル部分だけから ID の文字を削除しておきます。
  また、表示を見ながら、各コントロールのサイズ等、調整しておきます。
  (2007 で最初作っているので、最後に「レイアウトの調整」から解除しておきます)

さて、ここからですが・・・このフォームのまま操作してみると、
・既に登録されているレコードを更新してみる
「業種」「業態」を変更すると、「T業種一覧」の内容が書き変わる
・新規レコードを追加してみる
「業種」「業態」から操作すると、「T業種一覧」に新規レコードとして追加される
「コード」から操作すると、既存のものを選択できるが、
 その後で、「業種」「業態」を変更すると、「T業種一覧」の内容が書き変わる

つまり、現状では、「業種」「業態」を操作して、「T業種一覧」から選択する・・・
この操作が出来ない。。。。

ここから「コード」「業種」「業態」の連携を考えていきます。

kEnt150_FI

1)現状の「コード」「業種」「業態」は、見るだけにする。

2)操作は、非連結の最背面に配置したコンボボックスで・・・・

最背面に重ねて配置した非連結コントロールは、フォーカスを得ると前面に・・・
また、フォーカスがなくなると元の位置(最背面)に移動する・・・
(背面に居る時には、重ねているので、それ自体は見えない)
この動きを使っていく事になります。

「コード」「業種」「業態」に重ねて、最背面に配置するものを作成します。
「コード」「業種」「業態」を選択し、コピー&貼り付け
名前を順に、「cbx0」「cbx1」「cbx2」に変更し、コントロールソースを削除しておきます。
背面に配置したものにフォーカスを移す・・・これは VBA でやりたいと思うので、
「cbx0」「cbx1」「cbx2」の「タブストップ」は「いいえ」とします。
この3つを選択後マウスで移動し、コピー元にうまく重ね、その後、最背面に移動させます。
最背面への移動は、マウス右クリック → 位置 → 最背面へ移動 の手順で・・・

3)操作途中の「業種」「業態」表示は、最前面の非連結テキストボックスで・・・・

基本的には、2)の重ね方で良いのですが1つ問題点が・・・・
「コード」は「業種」「業態」の2つが求まって、初めて決定されるもの・・・
つまり、「コード」が一意に決まっていなければ、途中の操作内容を表示してあげないと・・・
「cbx1」をいじって「コード」が決まっていなければ、「cbx2」を操作するんでしょう・・・
この時、「cbx1」からフォーカスが外れ、最背面に戻ったら・・・何も表示されない・・・
もちろん、見るためだけの「業種」は、「コード」が決まっていないので、空欄のまま・・・
で、今度は「業種」「業態」にテキストボックスを最前面として重ねる事をします。

「業種」「業態」を選択後、コピー&貼り付け
マウス右クリックし、「コントロールの種類の変更」でテキストボックスへ
「業種」「業態」はテキストボックスの下になるので、「タブストップ」は「いいえ」としておきます。
テキストボックス名は「txt1」「txt2」としておきます。
このテキストボックスを最前面に設定してから、「業種」「業態」に綺麗に重ねます。
このテキストボックスの役目は、下に隠れた操作途中の「cbx1」「cbx2」の代わりに文字列を表示する・・・
なので、通常は下にある「業種」「業態」が見えないと困るので、背景スタイルは透明にします。


細工)

・テキストボックスの表示

テキストボックス「txt1」は、後ろに隠れたコンボボックス「cbx1」の表示内容を・・・
ただ、非連結なので、むやみに表示してしまうと、全レコード同じ表示になってしまう。
操作しているレコードだけで表示できれば良いので・・・・

そこで、フォームのヘッダに非表示のテキストボックス「txt0」を設け、
現在の「企業ID」(オートナンバ)を「txt0」に設定するようにします。
この方法は、カレント行に色を付ける・・・・の、基本的方法ですね。
タイミングとしては、「レコード移動時」「取り消し時」と「挿入前処理」の直後・・・・
( 2000 には「取り消し時」は無いので、意図通りには動きません)
新規レコード追加時のオートナンバは「挿入前処理」を戻った後に採番されるようです。
なので、「タイマー時」を 10ms で利用した「企業ID」→「txt0」設定に・・・
「レコード移動時」「取り消し時」でも同じ動きをさせるように、「タイマー時」を利用。

テキストボックス「txt1」のコントロールソースに以下を設定
=CheckView1(Nz([企業ID]))

で、その関数の処理は
Private Sub Form_Timer()
  Me.TimerInterval = 0
  Me.txt0 = Me.企業ID
End Sub

Private Function CheckView1(iNum As Long) As String
  On Error Resume Next
  CheckView1 = ""
  If (Nz(Me.txt0) = iNum) Then CheckView1 = Me.cbx1.Column(1)
End Function


Private Function CheckView2(iNum As Long) As String
  On Error Resume Next
  CheckView2 = ""
  If (Nz(Me.txt0) = iNum) Then CheckView2 = Me.cbx2.Column(1)
End Function

Private Sub Form_Current()
  ' 他処理
  ' ・・・・
  Me.TimerInterval = 10
End Sub

Private Sub Form_Undo(Cancel As Integer)
  ' 他処理
  ' ・・・・
  Me.TimerInterval = 10
End Sub

Private Sub Form_BeforeInsert(Cancel As Integer)
  Me.TimerInterval = 10
End Sub


・操作用コンボボックス

デザイン上で「cbx0」「cbx1」「cbx2」を作った時、「値集合ソース」は変更していなかったので、
「値集合ソース」に設定する SQL を定義し、フォームの「読み込み時」に設定します。
(動的に変更するものではないので、デザイン上で設定しても良いけど・・・)
Const CSQL0 As String = "SELECT Q1.コード, Q1.業種ID, Q2.業種, Q1.業態ID, Q3.業態 " _
        & "FROM (T業種一覧 AS Q1 INNER JOIN T業種 AS Q2 ON Q1.業種ID = Q2.業種ID) " _
        & "INNER JOIN T業態 AS Q3 ON Q1.業態ID = Q3.業態ID " _
        & "WHERE IIF(IsNull([cbx1]),True,Q1.業種ID=[cbx1]) AND " _
        & "IIF(IsNull([cbx2]),True,Q1.業態ID=[cbx2]);"

Const CSQL1 As String = "SELECT * FROM T業種 WHERE 業種ID IN " _
        & "(SELECT 業種ID FROM T業種一覧 WHERE IIF(IsNull([cbx2]),True,業態ID=[cbx2]));"

Const CSQL2 As String = "SELECT * FROM T業態 WHERE 業態ID IN " _
        & "(SELECT 業態ID FROM T業種一覧 WHERE IIF(IsNull([cbx1]),True,業種ID=[cbx1]));"

Private Sub Form_Load()
  Me.cbx1 = Null
  Me.cbx2 = Null
  Me.cbx0 = Null
  Me.cbx0.RowSource = CSQL0
  Me.cbx1.RowSource = CSQL1
  Me.cbx2.RowSource = CSQL2
  Me.cbx1.AfterUpdate = "=cbx12Change()"
  Me.cbx2.AfterUpdate = "=cbx12Change()"
End Sub
ここで、他のコンボを参照する際、コントロール名だけで十分です。
コントロール名だけの記述にしておくと、
・1つのフォームとして表示・・・・
・サブフォームとして組み込み・・・・
どちらでも動くものになります。

ただ、フォームのレコードソース部分での記述では、自フォームにあるコントロールでも
Forms!フォーム名!コントロール名
と記述しないといけないみたい(?嘘かも)ですが・・・・

「業種」「業態」の操作用途にあたる「cbx1」「cbx2」の「更新後処理」では、
設定により「コード」(「cbx0」)が一意になるか・・・・これをチェックします。
Private Function cbx12Change()
  With Me.cbx0
    .Requery
    If ((.ListCount + .ColumnHeads) = 1) Then
      .Value = .ItemData(.ListCount - 1)
      Me.cbx1 = CLng(Me.cbx0.Column(1))
      Me.cbx2 = CLng(Me.cbx0.Column(3))
      Me.コード = .Value
    Else
      .Value = Null
      If (Not IsNull(Me.コード)) Then Me.コード = Null
    End If
  End With
End Function
まず、
・「cbx1」「cbx2」の変更により、「cbx0」の表示が1件になるか? これを確認します。
・1件・・・・これの判別は、(.ListCount + .ColumnHeads) = 1 で。
「列見出し」を「はい」としていると、1件でも ListCount は2となります。
つまり、列見出しの文字列部分も ListCount 内でカウントされているようです。
なので、列見出しがあった場合、 ColumnHeads は True( -1 )なので数値として利用しています。
・で、1件ならその値を設定し、それに伴い「cbx1」「cbx2」へ値を設定し直します。
1件にならなければ、Null を設定しておいて・・・・
もし、更新操作で「コード」が設定されていたのなら、見る側の「コード」も Null へ・・・

・フォーカスの移動

「コード」「業種」「業態」部分はコントロールを重ねているので、
マウスでクリックできるのは、前面の「コード」「txt1」「txt2」になります。
これにフォーカスが入ろうとした場合、最背面に配置した操作用のコントロールにフォーカスを移します。
フォーカスが移されてくる先はコンボボックスなので、Requery し Dropdown 表示するようにします。
例えば、
Private Sub txt1_Enter()
  Me.cbx1.SetFocus
End Sub

Private Sub cbx1_Enter()
  Me.cbx1.Requery
End Sub

Private Sub cbx1_GotFocus()
  Me.cbx1.Dropdown
End Sub

※ サンプルファイルでは、
テキストボックスの幅が小さく、下のコンボボックス(見るだけ用途)がクリックできちゃいます。
これは間違いで、本来はコンボボックスの幅と同じ・・・が良いです。
動作確認時には、表示されているところ・・・下三角マークじゃない所をクリックしてください。

こんな感じで、処理を組み立てていきます。
記述した全部は以下
Const CSQL0 As String = "SELECT Q1.コード, Q1.業種ID, Q2.業種, Q1.業態ID, Q3.業態 " _
        & "FROM (T業種一覧 AS Q1 INNER JOIN T業種 AS Q2 ON Q1.業種ID = Q2.業種ID) " _
        & "INNER JOIN T業態 AS Q3 ON Q1.業態ID = Q3.業態ID " _
        & "WHERE IIF(IsNull([cbx1]),True,Q1.業種ID=[cbx1]) AND " _
        & "IIF(IsNull([cbx2]),True,Q1.業態ID=[cbx2]);"

Const CSQL1 As String = "SELECT * FROM T業種 WHERE 業種ID IN " _
        & "(SELECT 業種ID FROM T業種一覧 WHERE IIF(IsNull([cbx2]),True,業態ID=[cbx2]));"

Const CSQL2 As String = "SELECT * FROM T業態 WHERE 業態ID IN " _
        & "(SELECT 業態ID FROM T業種一覧 WHERE IIF(IsNull([cbx1]),True,業種ID=[cbx1]));"


Private Sub Form_Timer()
  Me.TimerInterval = 0
  Me.txt0 = Me.企業ID
End Sub

Private Function CheckView1(iNum As Long) As String
  On Error Resume Next
  CheckView1 = ""
  If (Nz(Me.txt0) = iNum) Then CheckView1 = Me.cbx1.Column(1)
End Function

Private Function CheckView2(iNum As Long) As String
  On Error Resume Next
  CheckView2 = ""
  If (Nz(Me.txt0) = iNum) Then CheckView2 = Me.cbx2.Column(1)
End Function

Private Sub Form_Load()
  Me.cbx1 = Null
  Me.cbx2 = Null
  Me.cbx0 = Null
  Me.cbx0.RowSource = CSQL0
  Me.cbx1.RowSource = CSQL1
  Me.cbx2.RowSource = CSQL2
  Me.cbx1.AfterUpdate = "=cbx12Change()"
  Me.cbx2.AfterUpdate = "=cbx12Change()"
End Sub

Private Sub Form_Current()
  Me.cbx1 = Null
  Me.cbx2 = Null
  Me.cbx0.Requery
  If (IsNull(Me.コード)) Then
    Me.cbx0 = Null
  Else
    Me.cbx0 = Me.コード
    Me.cbx1 = CLng(Me.cbx0.Column(1))
    Me.cbx2 = CLng(Me.cbx0.Column(3))
  End If
  Me.TimerInterval = 10
End Sub

Private Sub Form_Undo(Cancel As Integer)
  Me.cbx1 = Null
  Me.cbx2 = Null
  Me.cbx0.Requery
  If (IsNull(Me.コード.OldValue)) Then
    Me.cbx0 = Null
  Else
    Me.cbx0 = Me.コード.OldValue
    Me.cbx1 = CLng(Me.cbx0.Column(1))
    Me.cbx2 = CLng(Me.cbx0.Column(3))
  End If
  Me.cbx1.Requery
  Me.cbx2.Requery
  Me.TimerInterval = 10
End Sub

Private Sub Form_BeforeInsert(Cancel As Integer)
  Me.TimerInterval = 10
End Sub

Private Sub コード_Enter()
  Me.cbx0.SetFocus
End Sub

Private Sub cbx0_Enter()
  Me.cbx0.Requery
End Sub

Private Sub cbx0_GotFocus()
  Me.cbx0.Dropdown
End Sub

Private Sub cbx0_AfterUpdate()
  Me.コード = Me.cbx0
  If (IsNull(Me.cbx0)) Then
    Me.cbx1 = Null
    Me.cbx2 = Null
  Else
    Me.cbx1 = CLng(Me.cbx0.Column(1))
    Me.cbx2 = CLng(Me.cbx0.Column(3))
  End If
End Sub

Private Function cbx12Change()
  With Me.cbx0
    .Requery
    If ((.ListCount + .ColumnHeads) = 1) Then
      .Value = .ItemData(.ListCount - 1)
      Me.cbx1 = CLng(Me.cbx0.Column(1))
      Me.cbx2 = CLng(Me.cbx0.Column(3))
      Me.コード = .Value
    Else
      .Value = Null
      If (Not IsNull(Me.コード)) Then Me.コード = Null
    End If
  End With
End Function

Private Sub txt1_Enter()
  Me.cbx1.SetFocus
End Sub

Private Sub cbx1_Enter()
  Me.cbx1.Requery
End Sub

Private Sub cbx1_GotFocus()
  Me.cbx1.Dropdown
End Sub


Private Sub txt2_Enter()
  Me.cbx2.SetFocus
End Sub

Private Sub cbx2_Enter()
  Me.cbx2.Requery
End Sub

Private Sub cbx2_GotFocus()
  Me.cbx2.Dropdown
End Sub

Private Sub btn1_Click()
  Call ShowExcel
End Sub

 

+α として、Excel 1シートに、複数の結果をエクスポートするには・・・・

これは、おまけ的なものになります。
私は、ほとんど Access のレポート機能は使えません。
データの再利用/自由な縮尺・・・等考えると、直接 Excel に・・・・
Excel に出力する・・・・穴埋め的なもの等あるので、DoCmd 系のものは使いません。

自分で組めば、同一シートに複数のクエリの結果表示・・・・容易です。
(穴埋め的なものは、コード量は増えますけど・・・・)

処理の概要としては、
「T企業」に登録してある企業一覧を表示する際、業種別に表示してみましょうか。
業種別・・・・
業種でソートすれば終わりじゃないの・・・・・と言われれば、そこで終わるんですが
業種が変わったら、空白行を入れたい・・・・
 (これも Excel に転記した後、Excel 側を順次チェックして、空白行を INSERT ・・・でも可能ですが)
また、もう1度フィールド名を表示したい・・・・
とかを、(無駄に)想定したものになります。

共通に使える関数を用意しておいて
Private Sub ExcelPrint(ws As Object, rs As ADODB.Recordset, sQ As String _
          , Optional iSkip As Long = 1 _
          , Optional bHead As Boolean = False)
  Dim iRow As Long
  Dim i As Long
  Const xlCellTypeLastCell = 11
  Const xlCenter = -4108

  If (iSkip < 0) Then
    iRow = 1
  Else
    iRow = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row + iSkip + 1
  End If
  With ws.Cells(iRow, 1)
    If (bHead) Then
      For i = 0 To rs.Fields.Count - 1
        .Offset(, i + 1) = rs(i).Name
      Next
      .EntireRow.HorizontalAlignment = xlCenter
      iRow = iRow + 1
    End If
  End With
  ws.Cells(iRow, 1) = sQ
  ws.Cells(iRow, 2).CopyFromRecordset rs
End Sub

どのワークシートに、このレコードセットの内容を、レコードセットの概要(sQ)、
既にある記述から何行ずらして、フィールドの表示は?
この5つを与えてみます。

A列には、レコードセットの概要・・・・B列以降に、レコードセットの中身を・・・

中では、自分がしたい処理を記述しておけば良いので・・・・・
ワークシート・・・・どの列・・・と言わずに使っている範囲から何行・・・
ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
を使いましょうか・・・・
でも、真っ白な時でも上記では 1 が得られるようで、書き出しが2行目からになってしまう。
なので、1行目からね・・・・を指定させるために iSkip < 0 なら1行目から・・・
で、フィールド名を表示したら、その行は、中央寄せ(HorizontalAlignment = xlCenter)しましょう。

もし、この関数の呼び出し元で、レコードセットを使い回しするとしたら・・・・
CopyFromRecordset により、EOF = True になるみたいなので、注意が必要・・・・

共通の関数は作ったので、関数を呼ぶ側の記述では、
「T業種」に登録されているものすべてを対象に・・・
ではなく、「T企業」に登録されている業種だけを対象にしましょう。

「T企業」をベースに表示したいもの一覧を用意しておいて、
「T企業」に登録されている業種で順繰りに Filter して・・・・
(この部分、複数のクエリで順次レコードセットを得る様にすると・・・同じ事になりますね)

Public Sub ShowExcel()
  Dim rsP As New ADODB.Recordset
  Dim rs As New ADODB.Recordset
  Dim bFirst As Boolean

  rsP.Source = "SELECT * FROM T業種 WHERE 業種ID IN " _
      & "(SELECT 業種ID FROM T業種一覧 WHERE コード IN " _
      & "(SELECT コード FROM T企業)) " _
      & "ORDER BY 業種;"
  rsP.Open , CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
  If (Not rsP.EOF) Then
    rs.Source = "SELECT Q1.企業ID,Q1.企業名, Q3.業種ID,Q3.業種, Q4.業態ID,Q4.業態 FROM T企業 AS Q1 " _
        & "INNER JOIN ((T業種一覧 AS Q2 INNER JOIN T業種 AS Q3 ON Q2.業種ID=Q3.業種ID) " _
        & "INNER JOIN T業態 AS Q4 ON Q2.業態ID=Q4.業態ID) ON Q1.コード=Q2.コード " _
        & "ORDER BY Q3.業種, Q1.企業名, Q4.業態;"
    rs.Open , CurrentProject.Connection, adOpenStatic, adLockReadOnly

    With CreateObject("Excel.Application")
      With .Workbooks.Add
        bFirst = True
        While (Not rsP.EOF)
          rs.Filter = "業種ID = " & rsP("業種ID")
          If (bFirst) Then
            Call ExcelPrint(.WorkSheets(1), rs, rsP("業種"), -1, True)
          Else
            Call ExcelPrint(.WorkSheets(1), rs, rsP("業種"))
'            Call ExcelPrint(.WorkSheets(1), rs, rsP("業種"), 0)
'            Call ExcelPrint(.WorkSheets(1), rs, rsP("業種"), 2, True)
          End If
          rsP.MoveNext
          bFirst = False
        Wend
        .WorkSheets(1).UsedRange.EntireColumn.AutoFit
      End With
      .Visible = True
    End With
    rs.Close
  End If
  rsP.Close
End Sub

 
で、
            Call ExcelPrint(.WorkSheets(1), rs, rsP("業種"))
'            Call ExcelPrint(.WorkSheets(1), rs, rsP("業種"), 0)
'            Call ExcelPrint(.WorkSheets(1), rs, rsP("業種"), 2, True)
の部分を順に有効にした時の Excel 出力は、以下の様になります。

kEnt150_Excel  kEnt150_Excel1  kEnt150_Excel2

この Excel 関係は、「Module2」に記述してあります。
フォームからは、
Private Sub btn1_Click()
  Call ShowExcel
End Sub
するだけです。


今回のサンプルでは、「コード」「業種」「業態」それぞれをいじれるようにしましたが、
通常は、いじれる部分は「コード」だけで、「業種」「業態」はテキストボックスにして、
コントロールソースを、=Me.コード.Column(1) / =Me.コード.Column(2) とかにすると思います。
(もちろん、Me.コード.Column(1) / (2) 部分は、それなりに得られるようにしておく必要あり・・・)

サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt150_2000.zipkEnt150_2003.zipkEnt150_2007.zip
 サイズ 37,67839,22642,115
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化


※ ( 2000 には「取り消し時」は無いので、その部分は意図通りには動きません)

※ 「cbx0」も非連結にしちゃったけど・・・連結にしていたら、もう少し楽だったのかも・・・
関連記事

2013/05/05

Category: やってみる

TB: --  /  CM: 0

top △

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

top △

コメントの投稿

Secret

top △


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