見出し画像

【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


この記事が気に入ったらサポートをしてみませんか？