Microsoft Access2003

Page 10 (2005/01)

リストボックスでさらに脱線
リストボックスはテーブル/クエリーか値リストかフィールドリストの3種類が表示に使えるのですが、ここでは関数を使ってリストの値を設定するテキストのサンプルを解読紹介してみます。
実行結果は右図のように、ディレクトリにある全ファイルをリストボックスに表示するものです。何に使うか?というと思いつきませんが、データベース・ファイルmdbのなかだけではなく、外にあるデータもこのように扱えるという面白さはあります。
このサンプル・フォームにはリストボックスをひとつ作るだけです。コードは一行もありません。
下のFunctionプロシージャをモジュール・ウィンドウのなかの適当なモジュールのなかに追加コピーします。もちろん、このフォームのプロシージャのなかにコピーしても同じです。
そして、このリストボックスの「値集合ソース」のなかに関数名 FillListBox を書くだけで終わりです。下のコードの "C:\"の部分を他のディレクトリ名に変えると、そこのファイルリストガ表示されます。
フォームがオープンするときに、下のコードが実行されてリストが表示されます。
通常、プロパティ・ウィンドウのなかに関数を書くときは =FunctionName(パラメータ・・・)と書くものですが、このようなケースでは、ただ関数名を書くだけです。
Public Function FillListBox(ctrCurControl As Control, vntID, vntRow, vntCol, vntCode)
  'リストボックスに指定されたディレクトリのファイルのリストを表示する
  Static aMyArray() As String, intArrayItems As Integer
  Dim vntReturnVal As Variant
  vntReturnVal = Null
  Select Case vntCode
    Case acLBInitialize
      intArrayItems = 0
      ChDrive "C"
      ChDir "C:\"
      ReDim aMyArray(0)
      aMyArray(intArrayItems) = Dir("*.*")
      Do Until aMyArray(intArrayItems) = ""
        intArrayItems = intArrayItems + 1
        ReDim Preserve aMyArray(intArrayItems)
        aMyArray(intArrayItems) = Dir
      Loop
      vntReturnVal = intArrayItems

    Case acLBOpen
      vntReturnVal = Timer
    Case acLBGetRowCount
      vntReturnVal = intArrayItems
    Case acLBGetColumnCount
      vntReturnVal = -1
    Case acLBGetColumnWidth
      vntReturnVal = -1
    Case acLBGetValue
      vntReturnVal = aMyArray(vntRow)
    Case acLBEnd
      Erase aMyArray
  End Select
  FillListBox = vntReturnVal
End Function
この関数の使い方の変わっているところは、引数をユーザーが指定するのではなくて、Accessが渡すらしい?ということです。
それから、何度も呼び出されるということ。呼び出されるたびにvntCodeの値が変わるので、case文とAccessの定数で処理を分岐させています。

変数はこのプロシージャの中で返値FillListBoxに値を渡すだけの変数vntReturnValだけがローカル変数で、何度も呼び出されるこの関数プロシージャのなかで値を保持していなくてはならない動的配列変数 aMyArray() とリストボックスに表示されるアイテム数を保持する変数 intArrayItems はプライベート変数として宣言されています。
上記コードでブルーで表示した部分で指定されたディレクトリのファイル名を配列変数 aMyArray()に順次代入しています。
ChDriveと ChDirはVBA関数で、名前の通りドライブとディレクトリを変更します。
ReDim aMyArray(0)
aMyArray(intArrayItems) = Dir("*.*")

Dir関数でファイル名を配列変数の1個目に代入します。Dirはこの下の行にも出てきますが、2回目に使用するときは引数は省略できます。
この次のDo・・ Loop処理で、動的配列に項目を追加しながらすべてのファイル名を配列に格納します。
あらたな配列を追加するのに ReDim Preserve を使うのは、以前に値を受け取った配列の値を保持したまま再宣言するためです。

すべてのファイル名が配列に格納されると、このイニシャライズのCase文を抜け出して関数は値を返して戻ります。返す値はリストボックスに表示するファイル名の総数です。このあと、次のCase文で配列の値を順番にテキストボックスに渡しているようです。
Case acLBGetValue
   vntReturnVal = aMyArray(vntRow)

しかし、このコード、フォームが終わるまでチェックされるみたいなので、これを使ったフォームでエラーを起こすとエラー処理終了から抜け出せないという厄介なことになります。
上のリストボックスで画像ファイルを表示
画像ファイルのあるフォルダを表示してみたので、ついでに選択した画像ファイルをイメージコントロールに表示するようにしてみました。
リストボックスは複数選択ではありません。画像を表示するためのコマンドボタンをふたつ作りました。
同じ事をやっているのですが、少しやり方が違います。
複数選択ではないのでもっと簡単な方法は無いものだろうか?と思うのですが、リストボックスはけっこうややこしいです。
Private Sub cmdDisp_Click()
  Dim varItm As Variant, strPicture As String
  For Each varItm In lstListBox.ItemsSelected
    strPicture = lstListBox.ItemData(varItm)
  Next varItm

  Select Case Right(strPicture, 3)
    Case "jpg", "bmp", "gif"
      イメージ5.Picture = strPicture
      Me.Repaint
  End Select
End Sub

Private Sub cmdDisplay_Click()
  Dim strPicture As String
  Dim intCounter As Integer, intCurrentItem As Integer
  For intCounter = 0 To lstListBox.ItemsSelected.Count - 1
    intCurrentItem = lstListBox.ItemsSelected(intCounter)
    strPicture = lstListBox.Column(1, intCurrentItem)
  Next

  Select Case Right(strPicture, 3)
    Case "jpg", "bmp", "gif"
      イメージ5.Picture = strPicture
      Me.Repaint
  End Select
End Sub
上のコードはあくまで複数選択を前提にしたものなのでループ処理を使っているわけですが、今回のような単一選択の場合はループを使わなくてもシンプルにできるはず・・・ということで、改良したのたのが下のコードです。結局1行に納まったのですけど、ふたつの方法がほとんど同じになってしまった(。。;)ゞ
ItemDataと Columnのどちらを使うか?の違いだけ。
ItemDataは連結列の値だから、今回のようにテキストボックスの表示列がひとつの場合はこれのほうが分かりやすい。
Columnを使えば連結列以外の項目でも取り込めるところが便利。
Private Sub cmdDisp_Click()
  Dim varItm As Variant, strPicture As String
  strPicture = lstListBox.ItemData(lstListBox.ItemsSelected(0))
  Select Case Right(strPicture, 3)
   ・・・・以下、上のコードと同じ・・・・
End Sub

Private Sub cmdDisplay_Click()
  Dim strPicture As String
  Dim intCounter As Integer
  strPicture = lstListBox.Column(1, lstListBox.ItemsSelected(0))

  Select Case Right(strPicture, 3)
   ・・・・以下、上のコードと同じ・・・・
End Sub
やれやれ、これで一段落か・・と思ったのですけど、このリストボックスに値を設定するFunctionプロシージャ。関数の中にドライブとディレクトリが固定値で入ってます。別に例題ですからこれでもいいのですけど、フォルダを指定できると面白いか・・と。
frmFillListBoxを開くときにFunctionが読み込まれるので、このフォームの中でディレクトリの指定はできないみたい。というわけで、別のフォームから呼び出すようにしてみました。
Functionプロシージャの方は ChDrive と ChDi r の二行をリマークしてしまいます。この状態ではこの関数はカレント・ディレクトリのファイルしか対象にしなくなります。
下の図のようなフォームでディレクトリを変更してから呼び出せばいいわけです。現在のカレント・パスを表示してから変更するフォルダを選択します。
Page 4 で使った FileDialog の定数を変えて少しアレンジすればOKでした。Page 4 ではファイルが対象でしたが、今度はフォルダが対象ですので、定数 msoFileDialogFolderPicker を使います。

これを作っていて気が付いたのですが、frmFillListBoxフォームで、リストボックスの値を選択する前にボタンを押すとエラーになりますので、非選択状態の時はコマンドボタンを使えないように変更しました。
Option Compare Database
Option Explicit
Private Sub cmdCallFLB_Click()
  DoCmd.OpenForm "frmFillListBox"
End Sub
Private Sub cmdSelectFolder_Click()
  Dim fileName As String
  Dim result As Integer 'ダイアログを終了した時に押したボタンの値を受け取る変数
  With Application.FileDialog(msoFileDialogFolderPicker) 'フォルダ選択のダイアログを設定表示する
    .Title = "画像のあるフォルダを選択してください"
    .AllowMultiSelect = False
    .InitialFileName = CurrentProject.Path
    result = .Show   'ここで入力待ち
    If (result <> 0) Then '0はキャンセル -1がOKボタンの返値
      fileName = .SelectedItems.Item(1) '別に変数を使わなくてもいいのだけど
      ChDir fileName
      txtNewPath = fileName
    End If
  End With
End Sub
Private Sub Form_Open(Cancel As Integer)
  lblCurDir.Caption = CurDir  '現在のパスをラベル lblCurDirに表示
End Sub


Page Topへ戻る