テーブルの任意のフィールドを選択して内容を表示するお手本データベース
図7-3-1 テーブルから任意のフィールドを選択してデータシート上に表示するサンプルデータベース
このサンプルデータベースは、Accessのテーブルから任意のフィールドを選択してデータシート上に表示します。テーブルのコンボボックスには、データベースに登録されているテーブルの一覧が表示されます。コンボボックスからテーブルを選択すると、左側のリストボックス（選択可能アイテムリスト）にフィールドの一覧が表示されます。一覧からフィールドを選択して＞のボタンをクリックすると、右側のリストボックス（選択されたアイテムリスト）に選択されたフィールドが表示されます。選択されたフィールドを戻すには＜ボタンをクリックします。＞＞ボタンをクリックすると、全てのフィールドが選択されます。＜＜ボタンをクリックすると、既に選択された全てのフィールドが解除されます。リストボックスから＞、＜ボタンをクリックする替わりに、フィールド名をダブルクリックすることもできます。
表示ボタンをクリックすると、選択したフィールドがデータシート上に表示されます。このサンプルデータベースでは、フォームにサブフォームを配置してデータはサブフォームに表示させています。サブフォームは、CreateForm()関数を使用して実行時ダイナミックに作成します。また、サブフォームに配置するコントロール（テキストボックス、コンボボックス、チェックボックス）は、CreateControl()関数を使用して実行時に作成します。データシートに表示されたフィールドの列幅は、データ長に合わせて自動調整されます。
このサンプルデータベース（CH7-3.mdb）では、以下に示すノウハウを習得することができます。
◆ データベースに登録されているテーブル名をコンボボックスに表示させる方法
◆ テーブルのフィールド名をリストボックスに表示させる方法
◆ リストボックスから複数のアイテムを選択/解除する方法
◆ サブフォームを実行時にダイナミックに作成する方法
◆ サブフォームにコントロールをダイナミックに作成する方法
◆ データシートに表示されているフィールドの列幅をデータの長さに合わせて自動調整する方法
◆ リンクテーブルが壊れていないか調べて、自動的に再リンクする方法
◆ Windowsのコモンダイアログを表示させる方法
◆ クラスモジュールの作り方
● サンプルデータベースで使用するテーブルを準備するには
１ Accessを起動したら作業フォルダに、新規データベースCH7-3.mdbを作成します。
２ メニューから外部データベースの取り込み、テーブルのリンクをクリックします。リンクのダイアログが表示されたら、AccessのサンプルデータベースNorthwind.mdbを選択してリンクボタンをクリックします。（Northwind.mdbは、デフォルトでは“C:\Program Files\Microsoft Office\Office\Samples”にインストールされます。）
３ テーブルのリンクダイアログが表示されたら、すべて選択のボタンをクリックします。最後に、OKボタンをクリックしてリンクを完了させます。
図7-3-2 Northwind.mdbの全てのテーブルをリンクさせる
４ データベースウィンドウに、Northwind.mdbの全てのテーブルが表示されているか確認します。
図7-3-3 CH7-3.mdbからNorthwind.mdbにテーブルがリンクされた例
５ テーブルの準備ができたらAccess を終了させます。
● テーブルから任意のフィールドを選択して表示させるフォームを作成するには
１ Access を起動したら、作業フォルダに作成したCH7-3.mdbを開きます。
２ データベースウィンドウからフォーム
をクリックしたら、一覧からデザインビューでフォームを作成するをダブルクリックします。フォームのデザインビューが表示されたら、sfrDatasheetの名称で保存して閉じます。このフォームは、サブフォームの雛型として使用します。実際に使用するサブフォームは、実行時にダイナミックに作成します。
３ サブフォームの雛型を作成したら、一覧からデザインビューでフォームを作成するをダブルクリックしてメインフォームを作成します。メインフォームのデザインビューが表示されたら、ツールボックスを表示させます。
４ ツールボックスからコンボボックスのアイコン
をクリックしたら、フォーム詳細の上位に配置します。このコンボボックスには、データベースに登録されているテーブルリストを表示させます。コンボボックスの値集合ソースは、実行時に設定します。
５ ツールボックスからリストボックスのアイコン
をクリックしたら、コンボボックスの下に左右２個のリストボックスを作成します。左側に配置したリストボックスには、選択可能アイテムを表示します。右側に配置したリストボックスには、選択したアイテムリストを表示します。
６ ツールボックスからコマンドボタンのアイコン
をクリックしたら、左右のリストボックスの間に４個（上から＞、＞＞、＜、＜＜）のコマンドボタンを作成します。これらのコマンドボタンは、フィールド名を左右のリストボックス間で移動させるときに使用します。
７ データベースウィンドウから項番２で作成したsfrDataSheetのアイコンをドラッグして、リストボックスの下に貼り付けます。サブフォームのプロパティを表示させたら、ソースオブジェクトを空白にします。
８ ツールボックスからコマンドボタンのアイコンをクリックしたら、コンボボックスの右側に２個（表示、閉じる）のコマンドボタンを作成します。
９ フォームに作成したコントロールのプロパティを表7-3-1のように設定します。
表7-3-1 メインフォームに作成したコントロールのプロパティ
|
コントロールの種類 |
プロパティ |
値 |
|
コンボボックス |
名前 |
cboTables |
|
値集合タイプ |
値リスト |
|
|
値集合ソース |
実行時設定 |
|
|
連結列 |
1 |
|
|
列数 |
1 |
|
|
リストボックス１ |
名前 |
lstAvailableItems |
|
値集合タイプ |
実行時設定 |
|
|
値集合ソース |
実行時設定 |
|
|
リストボックス２ |
名前 |
lstSelectedItems |
|
値集合タイプ |
実行時設定 |
|
|
値集合ソース |
実行時設定 |
|
|
コマンドボタン１ |
名前 |
cmdAddOne |
|
標題 |
> |
|
|
コマンドボタン２ |
名前 |
cmdAddAll |
|
標題 |
>> |
|
|
コマンドボタン３ |
名前 |
cmdRemoveOne |
|
標題 |
< |
|
|
コマンドボタン４ |
名前 |
cmdRemoveAll |
|
標題 |
<< |
|
|
コマンドボタン５ |
名前 |
cmdView |
|
ヒントテキスト |
テーブルの内容表示 |
|
|
コマンドボタン６ |
名前 |
cmdClose |
|
ヒントテキスト |
フォームを閉じる |
|
|
サブフォーム |
名前 |
sfrDataSheet |
|
ソースオブジェクト |
空白 |
図7-3-4 メインフォームに配置したコントロールのレイアウト
１０ メニューからコードのアイコン
をクリックしたら、フォームモジュールを表示させます。CH7-3.mdbを開いたら、frmMultiSelectListBoxのフォームモジュールをコピーして貼り付けます。フォームモジュールのソースコードは、リスト7-3-1を参照してください。本書CD-ROMのCH7-3.mdbから標準モジュールbasAutoSize, basLinkedTables, basMyLib, basWindowsCommonDialogとクラスモジュールclsMyBoxをコピーします。これらのモジュールは、フォームモジュールから参照します。これらのモジュールは、Microsoft DAO 3.6 Object Library, Microsoft ADO Ext. 2x for DDL and
Securityのライブラリを参照しますので、VBEのツールメニューから参照設定をクリックして登録してください。
１１ フォームをビューモードに切り替えたら、テーブルのコンボボックスから得意先をクリックします。得意先テーブルを選択すると、フォーム左側のリストボックスに得意先テーブルのフィールドリストが表示されます。フィールドリストから得意先コード、得意先名、部署、担当者名、電話番号、都道府県をダブルクリックして選択します。選択したフィールドが右側のリストボックスに表示されていることを確認したら、表示ボタンをクリックします。サブフォームとサブフォームのテキストボックスがダイナミックに作成されて、得意先のデータシートが表示されます。サブフォームのデータシートに作成されたフィールドの列幅は、データ長に合わせて自動調整されます。
図7-3-5 得意先テーブルの得意先コード、得意先名、部署、担当者名、電話番号、都道府県を選択して表示させた例
１２ フォームをfrmMultiSelectListBoxの名称で保存したらAccess を終了します。
Form_Open()イベント処理
このイベントは、フォームが開かれたときに発生します。このイベントでは、VerifyLinks_FS()関数を使用して、リンクテーブルのリンクが壊れていないか調べます。壊れているときは、再リンクします。VerifyLinks_FS()は、モジュールbasLinkedTablesに登録されています。リンクテーブルのリンクを調べたら、New clsMyBoxでクラスモジュールのインスタンスを作成します。ここで作成したインスタンスは、リストボックスに表示されているアイテムを移動するときに使用します。
With Me
Set mobjAvailableItems = New
clsMyBox
Set mobjAvailableItems.Control
= .lstAvailableItems
Set mobjSelectedItems = New
clsMyBox
Set mobjSelectedItems.Control =
.lstSelectedItems
End With
Form_Load()イベント処理
このイベントは、フォームが開かれてデータをロードするときに発生します。このイベントでは、CurrentDataオブジェクトのAllTablesプロパティを参照して、データベースに登録されているテーブル名を取得します。
For Each obj In CurrentData.AllTables
With obj
If Left(.Name, 4)
<> "Msys" Then
strValue = strValue & ";" & .Name
End If
End With
Next obj
取得したテーブルリストは、コンボボックスの値集合ソース(RowSource)に設定します。
Me.cboTables.RowSource = strValue
Form_Close()イベント処理
このイベントは、フォームが閉じられるときに発生します。このイベントでは、フォームのOpenイベントで作成したclsMyBoxのインスタンスを解放します。
Set
mobjAvailableItems = Nothing
Set mobjSelectedItems = Nothing
cmdView_Click()イベント処理
このイベントは、フォームのデータ表示のコマンドボタンをクリックしたときに発生します。このイベントでは、リストボックスの右側に表示されているフィールドリストを元にSQLコマンドを作成して、サブプロシージャCreateDataSheetを呼びます。
strSQL = "SELECT "
intFldCount =
.ListCount
For intI = 1 To
.ListCount
strSQL = strSQL & .ItemData(intI) & ", "
Next intI
CreatDataSheetでは、データシート用のサブフォームとコントロールをダイナミックに作成してsfrDataSheetの名称で保存します。サブフォームを作成したら、メインフォームのSourceObjectにサブフォームの名称を設定して表示させます。
Me.sfrDataSheet.SourceObject = vbNullString
Call CreateDataSheet(strSQL)
Me.sfrDataSheet.SourceObject = conDataSheet
cmdClose_Click()イベント処理
このイベントは、フォームから閉じるのボタンをクリックしたときに発生します。このイベントでは、DoCmdのCloseメソッドでフォームを閉じます。
cboTables_AfterUpdate()イベント処理
このイベントは、テーブルのコンボボックスからアイテムを選択したときに発生します。このイベントでは、ADOを使用してコンボボックスで選択したテーブルのフィールド名を取得して、リストボックスに表示させます。レコードセットオブジェクトのOpenメソッドでテーブルを開いたら、For Each…Nextのループでリストボックスにフィールド名を追加します。
.Open strSQL, _
CurrentProject.Connection, _
adOpenStatic,
adLockReadOnly, adCmdText
フィールド名をリストボックスに追加するには、clsMyBoxオブジェクトのAddItemメソッドを使用します。クラスモジュールclsMyBoxについては、紙面の都合上説明を省略しますので、詳細はclsMyBoxのソースコードを参照してください。
For Each fld In .Fields
With
mobjAvailableItems
.AddItem fld.Name
End With
Next fld
lstAvailableItems_DblClick()イベント処理
このイベントは、左側のリストボックスからフィールド名をダブルクリックしたときに発生します。このイベントでは、cmdAddOne_Clickを呼び出して、＞のコマンドボタンをクリックしたときの処理を行います。
lstSelectedItems_DblClick()イベント処理
このイベントは、右側のリストボックスからフィールド名をダブルクリックしたときに発生します。このイベントでは、cmdRemoveOne_Clickを呼び出して、＜のコマンドボタンをクリックしたときの処理を行います。
cmdAddOne_Click()イベント処理
このイベントは、フォームから＞のコマンドボタンをクリックしたときに発生します。このイベントでは、左側のリストボックスから選択したフィールドを右側のリストボックスに移動します。選択したアイテムを右側のリストボックスに追加するには、clsMyBoxオブジェクトのAddItemメソッドを使用します。左側のリストボックスからアイテムを削除するには、clsMyBoxオブジェクトのRemoveSelectedメソッドを使用します。これらのメソッドは、clsMyBoxに登録されていますので、詳細はソースコードを参照してください。
With Me.lstAvailableItems
For Each varItem In
.ItemsSelected
mobjSelectedItems.AddItem .ItemData(varItem)
Next varItem
End With
mobjAvailableItems.RemoveSelected
cmdAddAll_Click()イベント処理
このイベントは、フォームから＞＞のコマンドボタンをクリックしたときに発生します。このイベントでは、左側のリストボックスに表示されている全てのフィールドを右側のリストボックスに移動します。右側のリストボックスにアイテムを追加するには、clsMyBoxオブジェクトのAddItemメソッドを使用します。左側のリストボックスから､全てのアイテムを削除するには、clsMyBoxオブジェクトのClearメソッドを使用します。
With Me.lstAvailableItems
For intItem = 0 To .ListCount -
1
mobjSelectedItems.AddItem .ItemData(intItem)
Next intItem
End With
mobjAvailableItems.Clear
cmdRemoveOne_Click()イベント処理
このイベントは、フォームから＜のコマンドボタンをクリックしたときに発生します。このイベントでは、右側のリストボックスから選択したフィールドを左側のリストボックスに移動します。
With Me.lstSelectedItems
For Each varItem In
.ItemsSelected
mobjAvailableItems.AddItem .ItemData(varItem)
Next varItem
End With
mobjSelectedItems.RemoveSelected
cmdRemoveAll_Click()イベント処理
このイベントは、フォームから＜＜のコマンドボタンをクリックしたときに発生します。このイベントでは、右側のリストボックスに表示されている全てのフィールドを左側のリストボックスに移動します。
With Me.lstSelectedItems
For intItem = 0 To .ListCount -
1
mobjAvailableItems.AddItem .ItemData(intItem)
End With
mobjSelectedItems.Clear
CreateDataSheet()
このプロシージャでは、サブフォームとサブフォームに配置されるコントロールを実行時にダイナミックに作成します。CreateForm()関数でフォームのオブジェクトを作成したら、オブジェクト変数frmに設定します。フォームのOnCurrentイベントに、"=AutoSize_FS([Form])"を埋め込みます。AutoSize_FS()関数は、データシート上に表示されるフィールドの列幅をデータ長に合わせて自動調整します。
Public Function
AutoSize_FS(frm As Form)
Dim ctl As Control
Const acSizeToFit =
-2
For Each ctl In
frm.Controls
If ctl.ControlType <> acLabel Then
If ctl.ColumnWidth <> 0 Then
ctl.ColumnWidth = acSizeToFit
End If
End If
Next
End Function
DefaultViewプロパティに、２を設定してデータシートモードにします。RecordSourceプロパティに、SQLコマンドを設定します。SQLコマンドは、プロシージャの引数で指定されています。
.OnCurrent
= "=AutoSize_FS([Form])"
.DefaultView = 2
.RecordSource =
strSQL
フォームに作成するコントロールの幅、高さのデフォルト値を設定したら、For intI….Nextのループでリストボックスで選択したフィールドに対応したコントロールを作成します。
フォームにコントロールを作成するには、CreateControl()関数を使用します。この関数は、コントロールの種類により引数が異なりますので、フィールドのデータ型を調べてデータ型に対応したコントロールを作成します。例えば、CreateControl()でテキストボックスのコントロールを作成するには、引数として、FormName, ControlType, Section, ColumnName, Left, Topを指定します。コントロール名には、フィールド名を設定します。
' Create TextBox
With CreateControl( _
FormName:=.Name, _
ControlType:=acTextBox, _
Section:=acDetail, _
ColumnName:=strFieldName, _
Left:=intI * (intWidth + intGap), _
Top:=(intHeight + intGap))
.Name = strFieldName
End With
リストボックスで選択した全てのフィールドのコントロールを作成したら、サブフォームをsfrDataSheetの名称で保存します。（CreateForm()関数は、自動的にフォーム名を付けて保存しますので、名前をsfrDataSheetに変更します。）
DoCmd.Close acForm,
conDataSheet
DoCmd.Close acForm, strFormName, acSaveYes
DoCmd.Rename conDataSheet, acForm, strFormName
リスト 7-3-1 frmMultiSelectListBoxのフォームモジュール
|
Option Compare Database Option Explicit Const conDataSheet = "sfrDataSheet" Dim mobjAvailableItems As clsMyBox Dim mobjSelectedItems As clsMyBox Private Sub cboTables_AfterUpdate() Dim cnn As ADODB.Connection Dim rs As ADODB.Recordset Dim fld As ADODB.Field Dim strSQL As String
strSQL = "SELECT * FROM " & Me.cboTables & ";"
Set cnn = CurrentProject.Connection Set rs = New ADODB.Recordset With rs .Open strSQL, _ CurrentProject.Connection, _ adOpenStatic, adLockReadOnly, adCmdText mobjAvailableItems.Clear mobjSelectedItems.Clear For Each fld In .Fields With mobjAvailableItems .AddItem fld.Name End With Next fld .Close End With Set rs = Nothing Set cnn = Nothing Me.sfrDataSheet.SourceObject = vbNullString
End Sub Private Sub cmdAddAll_Click() Dim intItem As Integer
With Me.lstAvailableItems For intItem = 0 To .ListCount - 1 mobjSelectedItems.AddItem .ItemData(intItem) Next intItem End With mobjAvailableItems.Clear End Sub Private Sub cmdAddOne_Click() Dim varItem As Variant
With Me.lstAvailableItems For Each varItem In .ItemsSelected mobjSelectedItems.AddItem .ItemData(varItem) Next varItem End With mobjAvailableItems.RemoveSelected End Sub Private Sub cmdRemoveAll_Click() Dim intItem As Integer
With Me.lstSelectedItems For intItem = 0 To .ListCount - 1 mobjAvailableItems.AddItem .ItemData(intItem) Next intItem End With mobjSelectedItems.Clear End Sub Private Sub cmdRemoveOne_Click() Dim varItem As Variant
With Me.lstSelectedItems For Each varItem In .ItemsSelected mobjAvailableItems.AddItem .ItemData(varItem) Next varItem End With mobjSelectedItems.RemoveSelected End Sub Private Sub lstAvailableItems_DblClick(Cancel As Integer) cmdAddOne_Click End Sub Private Sub lstSelectedItems_DblClick(Cancel As Integer) cmdRemoveOne_Click End Sub Private Sub cmdClose_Click() DoCmd.Close End Sub Private Sub cmdView_Click() Dim strSQL As String Dim ctl As Control
Dim intFldCount As Integer Dim intI As Integer
If mobjSelectedItems.ListCount = 0 Then MsgBox "ﾃｰﾌﾞﾙのﾌｨｰﾙﾄﾞを選択してください！", vbCritical + vbOKOnly Exit Sub End If
With mobjSelectedItems strSQL = "SELECT " intFldCount = .ListCount For intI = 1 To .ListCount strSQL = strSQL & .ItemData(intI) & ", " ' 1-based index Next intI End With strSQL = Left(strSQL, Len(strSQL) - 2) & " FROM " & Me.cboTables & ";"
Me.sfrDataSheet.SourceObject = vbNullString Call CreateDataSheet(strSQL) Me.sfrDataSheet.SourceObject = conDataSheet
End Sub Private Sub Form_Close() Set mobjAvailableItems = Nothing Set mobjSelectedItems = Nothing End Sub Private Sub Form_Load() Dim obj As AccessObject Dim strValue As String For Each obj In CurrentData.AllTables With obj If Left(.Name, 4) <> "Msys" Then strValue = strValue & ";" & .Name End If End With Next obj strValue = Mid(strValue, 2) Me.cboTables.RowSource = strValue
End Sub Private Sub Form_Open(Cancel As Integer) If Not VerifyLinks_FS("Northwind.mdb", "得意先") Then MsgBox "テーブルの再リンクに失敗しました！" & vbCrLf & _ "Accessのリンクテーブルマネージャから" & _ " Northwind.mdb を再リンクしてください.", _ vbCritical + vbOKOnly End If
Call SetAppTitle_FS("MultiSelect ListBox (C) " & Year(Date) & " by Akio Kasai") With Me Set mobjAvailableItems = New clsMyBox Set mobjAvailableItems.Control = .lstAvailableItems Set mobjSelectedItems = New clsMyBox Set mobjSelectedItems.Control = .lstSelectedItems End With End Sub Private Sub CreateDataSheet(strSQL As String)
Const acSizeToFit = -2 Const conTwipsPerInch As Long = 1440
Dim frm As Form Dim intI As Integer Dim intHeight As Integer Dim intWidth As Integer Dim intGap As Integer Dim intFldCount As Integer Dim strFormName As String
Dim db As DAO.Database Dim tdf As DAO.TableDef Dim fld As DAO.Field Dim strFieldName As String Dim strRowSource As String Set db = CurrentDb Set tdf = db.TableDefs(Me.cboTables) Set frm = CreateForm() With frm strFormName = .Name .OnCurrent = "=AutoSize_FS([Form])" .DefaultView = 2 .RecordSource = strSQL intHeight = 0.2 * conTwipsPerInch intWidth = 0.3 * conTwipsPerInch intGap = 0.03 * conTwipsPerInch
With .DefaultControl(acTextBox) .Width = intWidth .Height = intHeight End With
With .DefaultControl(acCheckBox) .Width = intWidth .Height = intHeight End With
With .DefaultControl(acComboBox) .Width = intWidth .Height = intHeight End With
intFldCount = mobjSelectedItems.ListCount
For intI = 1 To intFldCount strFieldName = mobjSelectedItems.ItemData(intI) Set fld = tdf.Fields(strFieldName) If fld.Type = dbBoolean Then ' Create CheckBox With CreateControl( _ FormName:=.Name, _ ControlType:=acCheckBox, _ Section:=acDetail, _ ColumnName:=strFieldName, _ Left:=intI * (intWidth + intGap), _ Top:=(intHeight + intGap)) .Name = strFieldName End With ElseIf fld.Type = dbLongBinary Then ' Create Object frame With CreateControl( _ FormName:=.Name, _ ControlType:=acBoundObjectFrame, _ Section:=acDetail, _ ColumnName:=strFieldName, _ Left:=intI * (intWidth + intGap), _ Top:=(intHeight + intGap)) .Name = strFieldName End With Else ' Text, Numeric, Date,.... On Error Resume Next strRowSource = Nz(fld.Properties("RowSource"), "") On Error GoTo 0 If Len(strRowSource) > 0 Then ' Create ComboBox With CreateControl( _ FormName:=.Name, _ ControlType:=acComboBox, _ Section:=acDetail, _ ColumnName:=strFieldName, _ Left:=intI * (intWidth + intGap), _ Top:=(intHeight + intGap)) .Name = strFieldName .RowSource = strRowSource .RowSourceType = "Table/Query" End With Else ' Create TextBox With CreateControl( _ FormName:=.Name, _ ControlType:=acTextBox, _ Section:=acDetail, _ ColumnName:=strFieldName, _ Left:=intI * (intWidth + intGap), _ Top:=(intHeight + intGap)) .Name = strFieldName End With End If End If Next intI End With On Error Resume Next DoCmd.Close acForm, conDataSheet DoCmd.DeleteObject acForm, conDataSheet DoCmd.Close acForm, strFormName, acSaveYes DoCmd.Rename conDataSheet, acForm, strFormName Set frm = Nothing Set tdf = Nothing Set db = Nothing End Sub |