【Excel VBA】開発を効率化!外部ファイルを扱うクラスモジュール
こんにちは、おくやんです。
Excel VBAの開発効率を大幅に向上させる、自作のライブラリクラスをご紹介しています。
今回はWorkbookオブジェクトを拡張した、外部ファイルの扱いに特化したライブラリクラスのご紹介です。
LibWorkSheetクラスと合わせてご利用ください
実際の開発現場でも20以上のツールに利用した実績のあるライブラリとなります。
皆さんも、ぜひ活用してみて下さい。
名称
LibWorkBookクラス
概要
Workbookオブジェクトを拡張したクラス
1つのExcelファイルに対して、1つのインスタンスを生成する
各シートに対応するLibWorkSheetクラスのインスタンスを生成する
関連クラス
LibWorkSheetクラスのインストールが必要
簡単な使い方
読み取り専用でのファイルOPNE/CLOSE
Excel形式のファイルやCSV、TSV形式のファイルを読み取り専用で開く。
' 読み取り専用でOPEN
Dim libWb As LibWorkBook: Set libWb = New LibWorkBook
Call libWb.OpenFileReadOnly(ThisWorkbook.path & "\table.xlsm ")
' LibWorkSheetインスタンス取得
Dim libWs As LibWorkSheet: Set libWs = libWb.Sheet("table1")
Dim ColNames As Variant: ColNames = libWs.ColNames
' 読込み
Debug.Print libWs.Val("1列目") '=> あ
Debug.Print libWs.Val("2列目") '=> い
Debug.Print libWs.Val("3列目") '=> う
' 保存せずにCLOSE
Call libWb.CloseFileWithoutSave
通常ファイルOPNE/CLOSE
Excel形式のファイルやCSV、TSV形式のファイルを開く。
上書き保存することができる。
' 通常OPEN
Dim libWb As LibWorkBook: Set libWb = New LibWorkBook
Call libWb.OpenFile(ThisWorkbook.path & "\table.xlsm ")
' LibWorkSheetインスタンス取得
Dim libWs As LibWorkSheet: Set libWs = libWb.Sheet("table1")
Dim ColNames As Variant: ColNames = libWs.ColNames
' 読込み
Debug.Print libWs.Val("1列目") '=> あ
Debug.Print libWs.Val("2列目") '=> い
Debug.Print libWs.Val("3列目") '=> う
' 書込み
libWs.Val("1列目") = "か"
libWs.Val("2列目") = "き"
libWs.Val("3列目") = "く"
' 読込み
Debug.Print libWs.Val("1列目") '=> か
Debug.Print libWs.Val("2列目") '=> き
Debug.Print libWs.Val("3列目") '=> く
' 保存してCLOSE
Call libWb.CloseFileWithSave
プロパティ定義
FileName() As String
対象ファイルのフルパスを返す
SheetList() As Variant
対象ファイルに含まれるシート名を配列形式で返す
Wb() As Workbook
対象ファイルのWorkbookオブジェクトを返す
Sheet(sheet_name, start_header_row, start_header_col, key_column) As LibWorkSheet
対象ファイルに含まれる表形式のデータを扱うLibWorkSheetインスタンスを返す
[PARAM] sheet_name As Variant
対象の表があるシートを指定する
シート名、シート番号指定が可能
[PARAM] Optional start_header_row As Long = 1
対象の表のヘッダー行数を指定する
省略した場合は1が設定される
[PARAM] Optional start_header_col As Long = 1
対象の表の開始列を指定する
省略した場合は1が設定される
[PARAM] Optional key_column As Variant = Empty
対象の表の主キーを指定する
省略した場合は主キー設定は行われない
関数定義
Init(wb_instance)
すでにオープン済みのファイル(Workbookオブジェクト)から、本クラスのインスタンスの初期化を行う
[PARAM] wb_instance As Workbook
対象ファイルのWorkbookオブジェクトを指定
OpenFileReadOnly(file_name) As Boolean
指定されたファイルを読み取り専用で開く
[PARAM] file_name As String
対象ファイルのパスを指定する
OpenFile(file_name) As Boolean
指定されたファイルを編集可能で開く
[PARAM] file_name As String
対象ファイルのパスを指定する
CloseFileWithoutSave()
保存せずにファイルをCLOSEする
CloseFileWithSave()
保存を行いファイルをCLOSEする
HasSheet(sheet_name) As Boolean
対象ファイルに指定されたシートが存在するかを返す
[PARAM] sheet_name As String
確認対象のシート名を指定する
ソースコード
Visual Basic Editorからクラスモジュール LibWorkBookを追加して、下記コードを張り付けてください。
Option Explicit
' メンバー定義
Private wb_ As Workbook
' Property定義
Public Property Get FileName() As String
FileName = Wb.FullName
End Property
Public Property Get SheetList() As Variant
Dim i As Long
Dim tmpSheetList As Variant: ReDim tmpSheetList(Wb.WorkSheets.Count - 1)
For i = LBound(tmpSheetList) To UBound(tmpSheetList)
tmpSheetList(i) = Wb.WorkSheets(i + 1).name
Next
SheetList = tmpSheetList
End Property
Public Property Get Wb() As Workbook
Set Wb = wb_
End Property
Private Property Set Wb(wb_instance As Workbook)
Set wb_ = wb_instance
End Property
Property Get Sheet( _
sheet_name As Variant, _
Optional start_header_row As Long = 1, _
Optional start_header_col As Long = 1, _
Optional key As Variant = Empty) As LibWorkSheet
' シート番号指定の場合を考慮し、シート名に変換
Dim tmpSheetName As String: tmpSheetName = SheetList(GetSheetNumber(sheet_name))
Dim libWs As LibWorkSheet: Set libWs = New LibWorkSheet
Call libWs.Init( _
sheet_name:=tmpSheetName, _
wb_instance:=Wb, _
start_header_row:=start_header_row, _
start_header_col:=start_header_col, _
key_column:=key)
Set Sheet = libWs
End Property
' Initialize定義
Private Sub class_initialize()
Call Init(ThisWorkbook)
End Sub
' Public Function定義
' Workbookインスタンス空の初期化
Public Function Init(wb_instance As Workbook)
Set Wb = wb_instance
End Function
' 読取り専用ファイルOpen処理
Public Function OpenFileReadOnly(file_name As String) As Boolean
OpenFileReadOnly = ReadFileData(file_name, True)
End Function
' ファイルOPEN処理
Public Function OpenFile(file_name As String) As Boolean
OpenFile = ReadFileData(file_name, False)
End Function
' 保存なしファイルClose処理
Public Function CloseFileWithoutSave()
Call CloseFile(False)
End Function
' 保存ありファイルClose処理
Public Function CloseFileWithSave()
Call CloseFile(True)
End Function
' シートが存在するか判定
Public Function HasSheet(sheet_name As String) As Boolean
Dim tmpSheetList As Variant: tmpSheetList = SheetList
HasSheet = (SheetNumberByName(sheet_name) <= UBound(tmpSheetList))
End Function
' Private Function定義
' シート名もしくはシート番号からシート番号を取得する処理
Private Function GetSheetNumber(sheet_name As Variant) As Long
Dim tmpNumber As Long
If HasSheet(CStr(sheet_name)) Then
' シート名指定
tmpNumber = SheetNumberByName(CStr(sheet_name))
ElseIf IsNumeric(sheet_name) Then
' 数値指定
tmpNumber = Int(sheet_name) - 1
End If
Dim tmpSheetList As Variant: tmpSheetList = SheetList
If tmpNumber < LBound(tmpSheetList) Or UBound(tmpSheetList) < tmpNumber Then
Err.Raise number:=10200, description:="指定されたシートが存在しません[シート:" & sheet_name & "]"
End If
GetSheetNumber = tmpNumber
End Function
Private Function SheetNumberByName(sheet_name As String) As Long
Dim tmpSheetList As Variant: tmpSheetList = SheetList
Dim i As Long
For i = LBound(tmpSheetList) To UBound(tmpSheetList)
If tmpSheetList(i) = sheet_name Then Exit For
Next
SheetNumberByName = i
End Function
' 各シート情報読み取り
' 指定されたファイルの全シート分WorkSheetDataオブジェクトを作成する
Private Function ReadFileData(file_name As String, read_option As Boolean) As Boolean
Dim alertFlg As Boolean: alertFlg = Application.DisplayAlerts
Application.DisplayAlerts = False
If read_option Then
Set Wb = workbooks.Open(FileName:=file_name, ReadOnly:=True, UpdateLinks:=False)
Else
Set Wb = workbooks.Open(FileName:=file_name, UpdateLinks:=False)
End If
Application.DisplayAlerts = alertFlg
ReadFileData = True
End Function
' ファイルClose処理
Private Function CloseFile(save_flg As Boolean)
If Wb Is Nothing Then Exit Function
Dim alertFlg As Boolean: alertFlg = Application.DisplayAlerts
Application.DisplayAlerts = False
If save_flg Then Wb.save
Wb.Close
Application.DisplayAlerts = alertFlg
End Function
この記事が気に入ったらサポートをしてみませんか?