ファイル一覧作成
【環境】Windows 10 Pro 64bit、Excel for Office 365
ExcelマクロのVBAを使用して、ファイル一覧を作成しています
さていよいよですが、最後に、一覧作成ボタンと一覧消去ボタンの処理を作成していきます
■出力項目
その3で実施した通り、ファイル一覧を作成するために、Fileオブジェクトを保存するようにしました
このFileオブジェクトが持つ情報を基にして、以下の内容を一覧に出力していきます
- サブフォルダ名
- ファイル名
- タイプ
- サイズ
- 作成日時
- 更新日時
■やること
一覧作成ボタンを押下した際に行うことは、ざっくりと以下になります
- シート情報の取得
- 出力先ワークシートの取得
- 一覧消去
- ファイル情報取得
- リスト作成
細かいことを言えば、以下のこともやらなきゃですが、今回はw
- 出力シートの有無確認
- 出力シートの作成/削除/複製
- 出力及び、出力済み一覧消去等の確認メッセージ表示
- 出力中の進捗状況表示
・シート情報の取得
これは表紙に記載された以下の内容を取得するということですが、その2で行ったように、ボタンへのマクロ登録時に、引数として渡す方法で、実装していきます
- カレントフォルダ
- ファイルパターン
- 出力シート名
やり方を忘れた方は、こちらを確認してください
引数でセル指定の文字列を受け取りって、セルの値を取得します
Sub MakeList(cell1 As String, cell2 As String, cell3 As String)
Dim path As String
Dim ptrn As String
Dim name As String
path = Me.Application.ActiveSheet.Range(cell1).Text
ptrn = Me.Application.ActiveSheet.Range(cell2).Text
name = Me.Application.ActiveSheet.Range(cell3).Text
End Sub
あまり、わしは、「Me.Application.ActiveSheet」なんてのを沢山書くのは好きではないです
更に、この「ActiveSheet」はプロパティなんですけど、見ての通り、型が「Object」型なので、WorkSheet型の変数にSetして使うようにしています
Sub MakeList(cell1 As String, cell2 As String, cell3 As String)
Dim wb As Workbook
Dim ws As Worksheet
Dim path As String
Dim ptrn As String
Dim name As String
Set wb = Me.Application.ActiveWorkbook
Set ws = wb.Worksheets("表紙")
path = ws.Range(cell1).Text
ptrn = ws.Range(cell2).Text
name = ws.Range(cell3).Text
Set ws = Nothing
Set wb = Nothing
End Sub
大したことではないのですが、Activeってのは、現在の最前面のウィンドウのこと(正確には違いますけどw)
Excelを複数開いていたりすると、Excelのウィンドウを切り替えた場合に、Activeが意図しないものに変わってしまいエラーの原因になります
そのため、Activeはボタンに登録するマクロで1回だけ、最初に使うだけにしましょー!
できれば、「表紙」も引数でもらえばいいですね!
・出力先ワークシートの取得
沢山ソースを書くのが、面倒になってきたので、抜粋していきますw
引数でもらった出力先シート名のセルの値を「name」に格納しているので、これを使って、シートのオブジェクトを取得します
Dim trg As Worksheet
Set trg = wb.Worksheets(name)
' Set trg = wb.Sheets(name) これでも同じです
Set trg = Nothing
WorkBook型やWorkSheet型は変数宣言をして、Setでオブジェクトを取得し、使い終わったら、「Set (変数名) = Nothing」で開放しましょー
・一覧消去
これは「一覧消去」ボタン押下時にも呼び出せるように、サブ関数化しておきましょ!こんな感じにw
Sub ClearListSub(ws As Worksheet)
Dim row As Long
Dim col As Long
Dim rows As Long
Dim cols As Long
row = 2 ' データ開始行
col = 1 ' Noの列
cols = 7 ' 列数
rows = 100 ' 行数
ws.Range(ws.Cells(row1, col1), ws.Cells(row2, col2)).ClearContents
End Sub
わかりやすく書いているつもりですが、本来は列数や行数は別の方法で取得していますし、ClearContentsの処理も別関数に切り出しています
Sub ClearListSub(ws As Worksheet)
Dim row As Long
Dim col As Long
Dim rows As Long
Dim cols As Long
row = LNG_START_ROW
col = LNG_START_COL
cols = GetLastCol(ws, row - 1) - col + 1
rows = GetLastRow(ws, col) - row + 1
Call ClearCellContents(ws, row, col, rows, cols)
End Sub
定数やサブ関数の中身は、ご想像にお任せしますw いつか公開するかもですが、想像つきますよねー?
・ファイル情報取得
これは「その3」で説明したので、割愛しますw
・リスト作成
あとはファイル情報取得で取得したdataを以下のように関数に渡して、For…Eachステートメントで回しながら、Fileオブジェクトに取得して、各プロパティを出力項目に割り当てていくだけです!
Sub MakeListSub(ws As Worksheet, data As Collection, path As String)
Dim row As Long
Dim no As Long
Dim fl As File
row = LNG_START_ROW
no = 0
For Each fl In data
' No.
ws.Cells(row + no, 1).Value = no + 1
' サブフォルダ名
ws.Cells(row + no, 2).Value = Replace(fl.ParentFolder, path, "")
' ファイル名
ws.Cells(row + no, 3).Value = fl.Name
' タイプ
ws.Cells(row + no, 4).Value = fl.Type
' サイズ
ws.Cells(row + no, 5).Value = fl.Size
' 作成日時
ws.Cells(row + no, 6).Value = Format(fl.DateCreated, "yyyy/mm/dd hh:nn:ss")
' 更新日時
ws.Cells(row + no, 7).Value = Format(fl.DateLastModified, "yyyy/mm/dd hh:nn:ss")
' Noをカウントアップ
no = no + 1
Next
End Sub
Valueにセットするのもサブ関数にしてしまう悪い癖があるので、判り易くベタに記載しておきますねw
列番号もEnumで定義することをお勧めします!
実際の一覧表を作成するときには、セルの罫線や書式の設定も必要になってきますので、その辺りはお好みで実装してください
■まとめると
一覧作成ボタンのマクロをを以下に掲載しますが、エラーチェック等は割愛していますので、程々に実装してくださいねーw
' 一覧作成
Sub MakeList(mysheet As String, cell1 As String, cell2 As String, cell3 As String)
Dim wb As Workbook
Dim ws As Worksheet
Dim trg As Worksheet
Dim path As String
Dim ptrn As String
Dim name As String
Dim data As Collection
' アクティブなワークブックを取得する
Set wb = Me.Application.ActiveWorkbook
' 表紙のワークシートを取得する
Set ws = wb.Worksheets(mysheet)
path = GetTextRange(ws, cell1) ' カレントフォルダ
ptrn = GetTextRange(ws, cell2) ' ファイルパターン
name = GetTextRange(ws, cell3) ' 出力先シート名
' 出力先
Set trg = wb.Worksheets(name)
' 消去
Call ClearListSub(trg)
' Fileオブジェクトを格納するコレクションを作成する
Set data = New Collection
' ファイル取得
Call GetFileInfo(data, path, ptrn)
' リスト作成
Call MakeListSub(trg, data, path)
' 後処理
Set data = Nothing
Set trg = Nothing
Set ws = Nothing
Set wb = Nothing
End Sub
■一覧消去ボタン
上のまとめたソースから必要なものだけを残せば、一覧消去ボタン押下時の関数はできてしまいますよね
Sub ClearList(mysheet As String, cell As String)
Dim wb As Workbook
Dim ws As Worksheet
Dim trg As Worksheet
Dim name As String
Set wb = Me.Application.ActiveWorkbook
Set ws = wb.Worksheets(mysheet)
name = GetTextRange(ws, cell)
Set trg = wb.Worksheets(name)
Call ClearListSub(trg)
Set trg = Nothing
Set ws = Nothing
Set wb = Nothing
End Sub
説明はいらないかな?w
■完成
というわけで、無事に一覧表が完成しました!
■最後に
今回はありきたりな画像ファイルを一覧するだけに留めていますが、何かとファイル一覧が必要になることは多いと思います
これをベースにCSVやExcelファイルを一覧して、更に、そのファイルを開いて自動処理をしていくなんてことも考えられますよね!?
もちろん、画像ファイルの一覧だって、これをベースにショッピングモールに出品する商品リストを作成するなんてことも・・
というわけで、今後は、以下のようなことを書いていこうかと思います
- セル制御、行挿入、列挿入、書式設定、条件付き書式、入力規則設定
- Excelシート一覧、シートを開く、シートの成型
- CSVファイル一覧、特定データの抽出、グラフ化、作表、集計
- HTML解析…等
やりたいことを挙げたらキリがないw
時間との兼ね合いで、簡単なところから、手を付けていきたいと思います!
ではでは