[三流君] −−＞ [ＶＢＡで楽しく] −−＞ [バックナンバー一覧]
−−＞ No.121 Excel UserForm リストボックスを使ってみた

Excel UserForm リストボックスを使ってみた

メルマガ発行内容

＜Excel UserForm リストボックスを使ってみた＞

どうも、三流プログラマーのＫｅｎ３です。

今回は、
Excelのユーザーフォームで、リストボックスを使ってみます。

サンプルファイルは、
http://www.ken3.org/vba/lzh/vba121.lzh
にvba121.xlsが保存されています。


/*
 * １. 今回のキッカケ
*/


掲示板のやりとりから、
-----
>投稿時間：2003/08/03(Sun) 11:26
>タイトル：Re^4: VBAでの自動解凍
>
>現在のコード 
>Option Explicit
>Private Declare Function Unlha Lib "UNLHA32.DLL" (ByVal Cal
>lhwnd As Long, ByVal LHACommand As String, ByVal RetBuff As Stri
>ng, ByVal RetBuffSize As Long) As Long
>Private Sub CommandButton1_Click()
>'********* UnLHA32.DLLを使ってLZHファイルを解凍する ***
>******
>Dim Ret As String * 255 'UnLHAからの結果を
>入れるバッファ（長さ255バイト）
>Dim SendStr As String 'コマンド゛文字列
>Dim sourceFile As String '解凍する圧縮ファイル
>Dim targetDir As String '解凍先ディレクトリ
>Dim Result As Long '戻り値
>
>targetDir = "C:\あ\い\"
>
>If targetDir = "" Then Exit Sub '解凍処理中止。
>ChDir "C:\LZHファイル"
>sourceFile = Application.GetOpenFilename("lzhファイル(*
>.lzh),*.lzh")
>
>SendStr = "e " & sourceFile & " " & targetD
>ir '（スペースで区切っていることに注意）
>Result = Unlha(0, SendStr, Ret, 255) 'UnLHA実行!
>If Result = 0 Then MsgBox (Ret) '解凍に
>成功したら、結果報告
>End Sub
>
>なんとか、ここまでたどり着きましたが「ＬＺＨファイル」フォルダ
>の中にあるlzhファイルの種類と数が多いので上の
>「Application.GetOpenFilename〜」では全てのlzhファイルがダイア
>ログボックスに表示してしまいます。
>そこで、ファイル名に含まれる文字である程度絞込み、その中からひ
>とつを選べるようにしたいのですが、どうすればいいでしょうか。
-----

*.lzhファイルが多いので、
ファイルに含まれる文字で絞り込みたいのかぁ。


/*
 * ２．Application.GetOpenFilenameをテストしてみる。
*/


そんなの簡単、vb*.lzhとワイルドカード指定でしょ？
と安易に思い、下記のテストを行ってみる。

下記、vb*.lzh指定でダメだったサンプルです・・
なにかありそうだけど・・・


Sub aaa()

    'ChDir "e:\work"
    Dim strFPTN As String  'ファイルパターン？
    strFPTN = "lzhファイル(vb*.lzh),vb*.lzh"

    Dim strFN As String
    strFN = Application.GetOpenFilename(strFPTN)

    MsgBox strFN

End Sub


あれ・・ダメなの？
でも、拡張子の指定は下記のようにするとＯＫなんだけど。


Sub bbb()

    'ChDir "e:\work"
    Dim strFPTN As String  'ファイルパターン？
    strFPTN = "lzhファイル(*.lzh), *.lzh"
    strFPTN = strFPTN & ",テキストファイル, *.txt;*.csv"

    Dim strFN As String
    strFN = Application.GetOpenFilename(strFPTN)

    MsgBox strFN

End Sub


上記指定で、
*.lzh
と
*.txt *.csv
のワイルドカードが指定可能。


↑ファイルの種類を指定してみた

頭のファイル名の部分は指定できないのかなぁ・・・なんか勘違いありそうだけど。


/*
 * ３．Excel UserForm の ListBoxを使ってみた
*/


何で出来ないんだろう・・・う〜ん・・・
Application.GetOpenFilename
のヘルプを見るが、いい方法がない。

あまりやりたくないけど、自作のユーザーフォームを作ってみます。

一覧から選択するので（選択したいので）、
リストボックスを使用してみます。

まずは、白紙のユーザーフォームを追加します。

Alt+F11でVBEの編集画面に行き、
次に、メニューから
挿入 -- ユーザーフォームを選択します。


すると、白紙のフォームを作成することが出来ます。


ツールボックスから
リストボックスコントロールを選択してフォームに貼ります。


フォームの初期化時のイベントで、
カレントディレクトリのvb*.lzhをリストボックスに追加してみます。


Private Sub UserForm_Initialize()
    'フォームの初期化イベントでリストボックスにデータをセットする
    Dim strWORK As String

    Me.ListBox1.Clear  '.Clearで内容を全てクリア

    strWORK = Dir("vb*.lzh")  'カレントのVB*.lzhを検索する
    While strWORK <> ""
        '取得したファイル名をリストに追加する、ITEMの追加
        Me.ListBox1.AddItem (strWORK)
        '次のファイル名を取得する
        strWORK = Dir() '引数無しで呼ぶと次のファイル名がセットされる
    Wend

End Sub


ポイントは、
^^^^^^^^^^^^
ListBox1.Clearと.Clearでリスト内の項目をクリア後、
Dir関数を使用して、カレントディレクトリ内のvb*.lzhを取得します。
取得したファイル名を、
.AddItemメソッドを使用して、セットしただけです。


↑リストボックスへセットした結果

リストボックスの中身を用意できたら、
次は、選択されたデータを判断したいですよね。

ボタンが押されたら、選択されたファイル名を表示してみます。
１つボタンのコントロールを追加して、
そのボタンのクリックイベントに書いてみます。


Private Sub btn01_Click()
    
    Dim strDATA As String
    
    strDATA = Me.ListBox1.Text  '.Textプロパティの値を代入
    
    MsgBox "選択されたデータは、" & strDATA

End Sub


まぁ、こんな感じで、選択されたデータを取り出せます。
.Textプロパティなんですね。


んっ、何も選択しないと、、まぁ=""で判断できるのかな。


Private Sub btn01_Click()
    Dim strDATA As String
    
    strDATA = Me.ListBox1.Text  '.Textプロパティの値を代入
    If strDATA = "" Then
        MsgBox "データを選択してからボタンを押してね"
    Else
        MsgBox "選択されたデータは、" & strDATA
    End If
End Sub



/*
 * ４．組み合わせて、LZHの解凍を呼ぶ
*/


さてと、組み合わせてみますか。

カレントディレクトリをセットして、
ユーザーフォームを呼ぶ、そんな関数を標準関数に作ります。


Sub ccc()
    'ChDrive "E"      'ドライブの変更
    'ChDir "e:\work"  'フォルダーの変更
    UserForm1.Show    'ユーザーフォームを表示する
End Sub


まぁ、こんな感じで、
ChDrive "E"      'ドライブの変更
ChDir "e:\work"  'フォルダーの変更
ドライブだったらこれでＯＫですね。
自分の環境に固定の場所を直してコメントを外してください。
※えっ、途中で変更したいって？まぁ、今回はカンベンしてよ・・・

ユーザーフォームで、ファイルを選択後、
LHAのファイルを解凍します。

userform1のモジュールです。
ボタンが押されたら、解凍するためにDLLを呼んでます。

Private Declare Function Unlha Lib "UNLHA32.DLL" (ByVal Callhwnd As Long, _
ByVal LHACommand As String, ByVal RetBuff As String, _
ByVal RetBuffSize As Long) As Long


Private Sub btn01_Click()
    
    Dim strDATA As String
    
    strDATA = Me.ListBox1.Text  '.Textプロパティの値を代入
    If strDATA = "" Then
        MsgBox "データを選択してからボタンを押してね"
        Exit Sub
    End If
    
    '********* UnLHA32.DLLを使ってLZHファイルを解凍する *********
    
    Dim Ret As String * 255  'UnLHAからの結果を入れるバッファ（長さ255バイト）
    Dim SendStr As String                'コマンド゛文字列
    Dim sourceFile As String             '解凍する圧縮ファイル
    Dim targetDir As String              '解凍先ディレクトリ
    Dim Result As Long                   '戻り値
    Dim Msg1 As String

    '↓解凍先ディレクトリ
    'targetDir = "e:\work\test\"  '←固定値をセットしてもいいし
    targetDir = CurDir() & "\"    'カレントディレクトリをセットする

    '↓解凍したい.lzhファイル
    sourceFile = CurDir() & "\" & strDATA
    '↑選択されたファイル名を＋して、フルパスを作成する
    
    'C:\Documents and Settings\ken3\My Documents
    'みたいに、スペース付のフォルダの予防で”chr(&h22)を付ける
    sourceFile = Chr(&H22) & sourceFile & Chr(&H22)
    targetDir = Chr(&H22) & targetDir & Chr(&H22)
  '"C:\Documents and Settings\ken3\My Documents"とダブルコーテーション付にする

    'ここで、コマンドを作っている
    SendStr = "e " & sourceFile & " " & targetDir
                    '（スペースで区切っていることに注意）
                                                    
    Result = Unlha(0, SendStr, Ret, 255)        'UnLHA実行!
        
    If Result = 0 Then MsgBox (Ret)             '解凍に成功したら、結果報告

    '作業が終了、フォームを閉じる
    Unload Me

End Sub


とくにポイントは無いんだけど、
ファイル名で（フォルダーで）
My Documents
みたいに、スペースが入っているフォルダーがあります。
これをそのままスペース区切りのコマンドに乗せると、
e C:My Documents\vb00aaa.lzh C:My Documents\
となり、正しく渡らないので、
""を付け（””で囲い）
e "C:My Documents\vb00aaa.lzh" "C:My Documents\"
がパラメータで渡るように細工してます。

あとは、うまくアレンジして、解凍処理を作れると思います。

フォームの初期化のタイミングで、ファイル名をセットする。
ホントは、ここで、フォルダーを変更したいが（変更機能がほしいが）
カレントディレクトリを対象としています。


Private Sub UserForm_Initialize()
    'フォームの初期化イベントでリストボックスにデータをセットする
    Dim strWORK As String
    
    Me.ListBox1.Clear  '.Clearで内容を全てクリア
    
    strWORK = Dir("vb*.lzh")  'カレントのVB*.lzhを検索する
    While strWORK <> ""
        '取得したファイル名をリストに追加する、ITEMの追加
        Me.ListBox1.AddItem (strWORK)
        '次のファイル名を取得する
        strWORK = Dir() '引数無しで呼ぶと次のファイル名がセットされる
    Wend

End Sub



/*
 * ５．終わりの挨拶
*/


今回は、
Excelのユーザーフォームで、
リストボックスを使用してみました。

例題は、ファイル名をセットして、選択だったけど、
いろいろと使ってみてください。

今回のサンプルファイルは、
http://www.ken3.org/vba/lzh/vba121.lzh
にvba121.xlsが保存されています。

テストして、遊んでみてください。

何かの参考となれば幸いです。

Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。

ページフッター

ここまで、読んでいただきどうもです。ここから下は、三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、

種類別のリンク や 広告など

気になったジャンル↓を選択してください。

人気記事(来場者が多いTOP3):
[VBAでIE,WebBrowserを操作]・・・VBAでIE,WebBrowserを操作する サンプルです
[Access から Excel 連携 CreateObject("Excel.Application")]・・・AccessからExcelを操作したりデータの書き出しなどです
[VBAでOutlookの操作 CreateObject("Outlook.Application" )]・・・VBAからOutlookを使い、メール関係を処理するサンプルです
↑上記３つみたいなCreateObjectで他のアプリケーションを操作するサンプルが人気です。

Excel関係:
[Excel UserFormを操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
[ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
[Excel関係 関数、その他]・・・その他Excel関係です

Access関係:
[Access UserForm/サブフォーム 操作]・・・アクセスでフォームを使ったサンプルです
[Access レポート操作]・・・レポートを操作してみました
[Access クエリーやその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です

その他：VBAの共通関数やテキストファイルの操作など
[VBAでテキストファイル(TextFile)の操作]・・・普通のテキストファイルを使ったサンプルです
[VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます

開発時の操作: [F1を押してHELPを見る]/ [Debug.Print と イミディエイトウインドウ]/ [実行時エラーでデバッグ]/ [ウォッチ式とSTOP]/ [参照設定を行う]

仕様書(設計書？) XXXX書類: [基本設計書や要求仕様書]/ [テスト仕様書 テストデータ]/ [バグ票]/ [関数仕様書]/ [流れは 入力・処理・出力]

※↑文章の味付けが変わっていて、お口に合うかわかりませんが。。。
※※読んで、気分を悪くされたらスミマセン。

Blogとリンク:[三流君の作業日記]/ [VBAやASPのサンプルコード]/ 広告-[通販人気商品の足跡]


[三流君(TOP ken3.org へ戻る)] / [VBA系TOPへ] / [VBA系バックナンバー目次へ移動]