ExcelのVBA中級者となってくると「他のブックを操作したい」という要求が出てきます。VBAは苦手な方や嫌いな方も多いため、普段使用するブックをマクロ有効ブックとしてしまうよりは、自分や同僚用の操作用ブックから目的の操作をする方が安心感があるように思います。VBAで一番有効なデザインパターンはこのようなFacadeパターンじゃないかと思います。
おお、依存性逆転っぽくてかっこよくありませんか?
他のブックを操作する際に必要になってくるのが、ブックが保存されているフォルダパスの取得です。
前回記述したフォルダパスを取得するスクリプトがお気に入りなので、そこだけ切り出して整理してみました。
今回は、フォルダを単純に選ぶ、というものと、何かしらの「原本となるブック」を選ぶというものを作成してみました。
例として「成績ブック」という原本がありそれが保存されているフォルダをダイアログから選べる、というものです。
原本となるブック
よくあるのが「原本となるブック」が指定されていて、それらを業務のたびにコピーしたりして使用するものです。
その原本はおそらく多岐にわたると思われます。その流動性のところにカプセル化をかましておきましょう。
「原本です」と取得できればよいので「どんなブック名が原本なのかは(流動性があるので)感知しない」というイメージです。
また今回は「ブック名にキーワードが含まれているExcelブック(.xlsx)であればよい」というルールで作成しました。このあたりのルールも流動性がありそうだと思いませんか?ですのでこちらもカプセル化してしまいましょう。カプセル化すればカプセルの外側の我々は感知しなくてもよくなります。「これは原本ですかね?原本をください。」と言えばいいだけで原本かどうかの処理はカプセル化の内側で行われるわけですね。
整理すると
- 「どんなブック名か」という流動性
- 「どのようなルールで原本とみなすか」という流動性
の2種類があるように思いました。ですのでそれぞれカプセル化してみましょう。「どんなブック名?(流動性があるので)知りません。どれを原本と判断する?(流動性があるので)知りません。」というスタンスです。
カプセル化ということでインターフェイスを使用します。何度も恐縮ですがVBAにも実はインターフェイスがあります。あまり人気ないんですけどね。
IBookLocator.cls
Option Explicit
Public Function Exists(p_folderpath As FolderPath, i_genponPolicy As IGenponPolicy) As Boolean
End Function
Public Function Load(p_folderpath As FolderPath, i_genponPolicy As IGenponPolicy) As Workbook
End Function
インターフェイスは何も中身がないプロシージャやモジュールレベル変数などを記述することで使用できます。どれか1つはPublicでないと使用できないので、どれかは必然的にPublicになります。
今回は「原本ブックが存在するか」と「原本ブックを開く」の2種類のプロシージャを設定しました。
では今回の例の「ブック名にキーワードが含まれているExcelブック(.xlsx)であればよい」というルールを作成してみます。
GenponBookLocatore.cls
Option Explicit
Implements IBookLocator
Private listbookName_ As String
Public Function IBookLocator_Exists(p_folderpath As FolderPath, i_genponPolicy As IGenponPolicy) As Boolean
Dim FileName As String
FileName = Dir(p_folderpath.path & "\" & "*" & i_genponPolicy.GetName & "*" & i_genponPolicy.GetExtension)
Do While FileName <> ""
' 拡張子を除いたファイル名に対してキーワードを検索
If InStr(1, Left(FileName, Len(FileName) - 5), i_genponPolicy.GetName, vbTextCompare) > 0 Then
IBookLocator_Exists = True
listbookName_ = p_folderpath.path & "\" & FileName
Exit Function
End If
FileName = Dir()
Loop
IBookLocator_Exists = False
FileName = ""
End Function
Public Function IBookLocator_Load(p_folderpath As FolderPath, i_genponPolicy As IGenponPolicy) As Workbook
Dim filePath As String
filePath = listbookName_
If Not IBookLocator_Exists(p_folderpath, i_genponPolicy) Then
Err.Raise vbObjectError + 1001, "BookLocator.Load", "ファイルが存在しません: " & filePath
End If
Set IBookLocator_Load = Workbooks.Open(FileName:=filePath)
End Function
Google検索してみたところ古のDir関数が引っ掛かりましたのでそちらを使用してみました。あいまいな検索でキーワードがあればよい、ということで「*」を使用しています。
Dir関数は古いだけありまして、ヒットするとそのファイル名が返ってくるという仕様です。(地味にハマりました。)
ファイルが存在しない時は「ファイルが存在しませんエラー」を発生させることにしてみました。
次に「どんなブック名が原本なのか」という流動性に対応しましょう。
IGenponPolicy.cls
Option Explicit
Public Function GetName() As String
End Function
Public Function GetPass() As String
End Function
Public Function GetExtension() As String
End Functionまた、空のプロシージャばかりのインターフェイスを作成しました。いずれはパスワードがかかったブックがあるかもしれませんので、パスワードも設定できます。
今回のルールは「成績ブック」というなまえで拡張子は普通の「.xlsx」だというルールだとしましょう。
GenponBookGenponPolicy.cls
Option Explicit
Private bookname_ As String
Private pass_ As String
Private extension_ As String
Private Const KEY_WORD As String = "成績ブック"
Private Const EXTENSION As String = ".xlsx" '".xlsm"
Implements IGenponPolicy
Private Sub Class_Initialize()
bookname_ = KEY_WORD
pass_ = ""
extension_ = EXTENSION
End Sub
Private Function IGenponPolicy_GetName() As String
IGenponPolicy_GetName = bookname_
End Function
Private Function IGenponPolicy_GetPass() As String
IGenponPolicy_GetPass = pass_
End Function
Private Function IGenponPolicy_GetExtension() As String
IGenponPolicy_GetExtension = extension_
End Function
VBAの文法上の理由で Implementsステートメントのあとにインターフェイス名が来ています。また、プロシージャ名が「インターフェイス名、アンダーバー、プロシージャ名」となっています。
やや固執する方も多いのが、インターフェイスではない具象クラスモジュール側ではPrivateで宣言する点です。私はどちらでも困ったことはそこまでないのですが、具体的な内容を記載した具象クラスモジュール側がPrivateだとインターフェイス型での宣言がより強要されていいと思います。
これで「成績ブック」というキーワードがあるブック名で拡張子が「.xlsm」というブックを判定するクラスモジュールが完成しました。
フォルダパス
実際のフォルダパスをクラスモジュールとして記述していきます。
FolderPath.cls
Option Explicit
Private folderpath_ As String
Public Sub Construct(p_folderpath As String)
If Exists(p_folderpath) Then
folderpath_ = p_folderpath
Else
Err.Raise vbObjectError + 1000, _
"FolderPathクラスモジュール", _
"指定されたフォルダは存在しません: " & p_folderpath
End If
End Sub
Private Function Exists(p_folderpath As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(p_folderpath) Then
Exists = True
Else
Exists = False
End If
End Function
Public Property Get path() As String
path = folderpath_
End Propertyここちらでも不正な値だった場合は「指定されたフォルダは存在しませんエラー」を発生させることにしました。
さて、このFolderPathクラスモジュールを生成するに際しまして
「フォルダを直接指定する」
「原本のブックが保存されているフォルダを取得する」
という2種類の挙動を考えました。
それぞれ別のクラスモジュールとして記述していきます。
また、実際にFolderPathクラスモジュールを生成する具体的な動きをするファクトリークラスモジュールを作成して、そこに実際の動作のプロシージャを作成し、それを引数にとることにしました。
おお、依存性の注入っぽくてかっこよくありませんか?
GetTargetFolderPathService.cls
Option Explicit
Public Function GetDefault(fp_factory As FolderPathFactory) As FolderPath
Set GetDefault = fp_factory.GetDefaultFolderPath
End Function
Public Function GetFromDialog(fp_factory As FolderPathFactory) As FolderPath
Set GetFromDialog = fp_factory.GetFolderPathFromDialog
End Function
Public Function GetFromFolderName(p_foldername As String, fp_factory As FolderPathFactory) As FolderPath
Set GetFromFolderName = fp_factory.CreateFromFolderName(p_foldername)
End Functionこちらは「フォルダを直接指定する」のをイメージしたクラスモジュールです。
ダイアログから指定したり、起動時に今のフォルダを取得したり、フォルダパスの文字列からそのフォルダパスクラスモジュールを生成することが出来ます。
GetGenponPathService.cls
Option Explicit
Const ERROR_INVALID_FOLDER_PATH As Long = vbObjectError + 1000
Public Function GetFromDialog(i_genponPolicy As IGenponPolicy, i_booklocator As IBookLocator, fp_factory As FolderPathFactory) As FolderPath
Dim fd As FileDialog
Dim SelectedFileName As String
Dim FolderPath As FolderPath
Do
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = i_genponPolicy.GetName & "ファイルを選択してください"
.Filters.Clear
.Filters.Add "Excelファイル", "*.xls; *.xlsx; *.xlsm"
.InitialFileName = ThisWorkbook.path & "\"
.AllowMultiSelect = False
If .Show = -1 Then
SelectedFileName = .SelectedItems(1)
Dim GenponPath As FolderPath
Set GenponPath = fp_factory.CreateFormFullFilePath(SelectedFileName)
If i_booklocator.Exists(GenponPath, i_genponPolicy) Then
Set GetFromDialog = GenponPath
Exit Function
Else
MsgBox i_genponPolicy.GetName & "ファイルを選択してください。", vbExclamation
SelectedFileName = ""
End If
Else
MsgBox i_genponPolicy.GetName & "ファイルを選択してください。", vbExclamation
SelectedFileName = ""
End If
End With
Loop While SelectedFileName = ""
Set fd = Nothing
End Function
Public Function CreateFormFullFilePath(p_fullfilepath As String, i_genponPolicy As IGenponPolicy, i_booklocator As IBookLocator, fp_factory As FolderPathFactory) As FolderPath
Dim GenponPath As FolderPath
Set GenponPath = fp_factory.CreateFormFullFilePath(p_fullfilepath)
If i_booklocator.Exists(GenponPath, i_genponPolicy) Then
Set CreateFormFullFilePath = GenponPath
Exit Function
Else
Set CreateFormFullFilePath = GetFromDialog(i_genponPolicy, i_booklocator, fp_factory)
End If
End Functionつ続きましてこちらは、「原本のブックが保存されているフォルダを取得する」をイメージしたクラスモジュールです。
ダイアログではExcelファイルを選んでもらい、それが条件に一致しているものであるかを判定しています。またファイルパスからFolderPathクラスモジュールを生成できます。
フォルダを選ぶダイアログと任意のファイルを選ぶダイアログと2種類あるみたいですね、VBAには。便利ですね。
これら2つのクラスモジュールが依存するのが実際の動作を集めた「FolderPathFactoryクラスモジュール」です。こちらを引数で注入して依存性注入を行いましょう。
FolderPathFactory.cls
Option Explicit
Private Const ERROR_INVALID_FOLDER_PATH As Long = vbObjectError + 1000
Private Const ERROR_NOT_FOUND_FOLDER As Long = vbObjectError + 2000
Public Function CreateFromFolderName(p_foldername As String) As FolderPath
On Error GoTo ErrHandler
Dim FolderName As String
FolderName = p_foldername
Dim FolderPath As FolderPath
Set FolderPath = New FolderPath
Call FolderPath.Construct(FolderName)
Set CreateFromFolderName = FolderPath
Exit Function
ErrHandler:
If Err.Number = ERROR_INVALID_FOLDER_PATH Then
FolderName = GetFolderPathStringFromDialog
Resume Next
End If
End Function
Public Function CreateFormFullFilePath(p_filepath As String) As FolderPath
Dim FolderName As String
FolderName = GetFolderPathStringFromFilePath(p_filepath)
Set CreateFormFullFilePath = CreateFromFolderName(FolderName)
End Function
Private Function GetFolderPathStringFromFilePath(filePath As String) As String
On Error GoTo ErrHandler
Dim pos As Long
pos = InStrRev(filePath, Application.PathSeparator)
If pos > 1 Then
GetFolderPathStringFromFilePath = Left(filePath, pos - 1)
Exit Function
Else
Err.Raise vbObjectError + 2000, _
"FolderPathFactoryクラスモジュール", _
"指定されたファイルパスにフォルダが存在しません: " & filePath
End If
ErrHandler:
If Err.Number = ERROR_NOT_FOUND_FOLDER Then
GetFolderPathStringFromFilePath = GetFolderPathStringFromDialog
Err.Clear
Else
' 想定外のエラーはそのまま再スロー
Err.Raise Err.Number, Err.Source, Err.Description
End If
End Function
Public Function GetDefaultFolderPath() As FolderPath
Dim DefaultFolder As String
Dim currentFolder As String
' 現在のブックのフォルダを取得
currentFolder = ThisWorkbook.path
If currentFolder = "" Or InStr(currentFolder, "\") = 0 Then
DefaultFolder = "C:"
Exit Function
Else
'GetDefaultFolderPath = Left(currentFolder, InStrRev(currentFolder, "\") - 1) ' 一つ上のフォルダを取得
DefaultFolder = currentFolder
End If
Set GetDefaultFolderPath = CreateFromFolderName(DefaultFolder)
End Function
Public Function GetFolderPathFromDialog() As FolderPath
Dim FolderName As String
FolderName = GetFolderPathStringFromDialog
Set GetFolderPathFromDialog = CreateFromFolderName(FolderName)
End Function
Private Function GetFolderPathStringFromDialog() As String
Dim fd As FileDialog
Dim SelectedFolder As String
Dim currentFolder As String
Dim parentFolder As String
' フォルダ選択ダイアログを作成
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Do
With fd
.Title = "フォルダを選択してください"
.InitialFileName = ThisWorkbook.path & "\"
.AllowMultiSelect = False
If .Show = -1 Then
SelectedFolder = .SelectedItems(1)
GetFolderPathStringFromDialog = SelectedFolder
Else
MsgBox "フォルダを選択する必要があります。", vbExclamation
End If
End With
Loop While SelectedFolder = ""
Set fd = Nothing
End Function
実際には先ほど記述した、IBookLocator型やIGenponPolicy型も引数にとりまして、総合的に作成していきます。
このように、なるべく引数で色々なオブジェクトを注入するのが一つのやり方であるみたいですね。
セルに表示する
次にセルに表示するクラスモジュールを作成しました。いよいよVBAって感じになってきましたね。
今回は「フォルダを直接指定する」のと「原本のブックが保存されているフォルダを取得する」の2種類の結果を表示することにしました。それぞれのボタンもつければそれっぽくなりそうですね。
色々なセルに表示する機能を持つのではなく今回はそれぞれ専任のクラスモジュールを作成しました。
表示するセルには名前を付けて、そこからRangeオブジェクトを指定しています。
それらのセルは勝手に削除されても困るので、その2つのセルだけロックを残してシートを保護しています。
DisplayFolderPathService.cls
Option Explicit
Public Sub DisplayFolderPath(p_folderpath As FolderPath)
Dim ws As Worksheet
Set ws = FolderPathAndGenponSheet
ws.Unprotect
ws.Range("FolderPath").ClearComments
ws.Range("FolderPath").Value = p_folderpath.path
ws.Protect UserInterfaceOnly:=True
End Sub
DisplayGenponService.cls
Option Explicit
Public Sub DisplayGenponName(p_folderpath As FolderPath, i_genponPolicy As IGenponPolicy)
Dim ws As Worksheet
Set ws = FolderPathAndGenponSheet
Dim filePath As String
filePath = p_folderpath.path & "\" & i_genponPolicy.GetName
ws.Unprotect
ws.Range("GenponFilePath").ClearComments
ws.Range("GenponFilePath").Value = filePath
ws.Protect UserInterfaceOnly:=True
End Sub
これで無事完成です。
ブックを開く際に初期設定してこれらを表示させています。
FolderPathAndGenponSheetモジュール
Public Sub initializeSheet()
Call InitializeFolderPath
Call InitializeGenponPath
End Sub
Private Sub InitializeFolderPath()
Dim GetTargetFolderPathService As GetTargetFolderPathService
Set GetTargetFolderPathService = New GetTargetFolderPathService
Dim FolderPathFactory As FolderPathFactory
Set FolderPathFactory = New FolderPathFactory
Dim FolderPath As FolderPath
Set FolderPath = GetTargetFolderPathService.GetDefault(FolderPathFactory)
Dim DisplayFolderPathService As DisplayFolderPathService
Set DisplayFolderPathService = New DisplayFolderPathService
Call DisplayFolderPathService.DisplayFolderPath(FolderPath)
End Sub
Private Sub InitializeGenponPath()
Dim GenponBookLocator As IBookLocator
Set GenponBookLocator = New GenponBookLocatore
Dim GenponBookGenponPolicy As IGenponPolicy
Set GenponBookGenponPolicy = New GenponBookGenponPolicy
Dim FolderPathFactory As FolderPathFactory
Set FolderPathFactory = New FolderPathFactory
Dim GetGenponPathService As GetGenponPathService
Set GetGenponPathService = New GetGenponPathService
Dim GenponFolderPath As FolderPath
Set GenponFolderPath = GetGenponPathService.CreateFormFullFilePath(FolderPathAndGenponSheet.Range("GenponFilePath").Value, GenponBookGenponPolicy, GenponBookLocator, FolderPathFactory)
Dim ListWb As Workbook
If Not GenponBookLocator.Exists(GenponFolderPath, GenponBookGenponPolicy) Then
Set GenponFolderPath = GetGenponPathService.GetFromDialog(GenponBookGenponPolicy, GenponBookLocator, FolderPathFactory)
End If
Dim DisplayGenponService As DisplayGenponService
Set DisplayGenponService = New DisplayGenponService
Call DisplayGenponService.DisplayGenponName(GenponFolderPath, GenponBookGenponPolicy)
End Sub今回はシートモジュールに記述しました。シートモジュールのオブジェクト名は「FolderPathAndGenponSheet」に変更しています。
フォルダ取得ボタン、原本ブック取得ボタン
最後の最後にボタンを押した際のプロシージャを作成しました。
先程の初期設定もそうでしたが、実際のプロシージャではクラスの宣言ばっかりで特別なことはしていません。「表示して」とか「フォルダ名ください」とかいうだけで、カプセル化の中身については感知していません。ExcelやVBAがどんなことをしているかには依存せず、「表示して」とか「フォルダ名下さい」という仕様に逆に依存しているわけですね。
また、それらのカプセル化の中身も何かに依存はいていなくて、必要なものは外部から注入してもらっている、というあたりがお気に入りポイントです。
FolderPathAndGenponSheetモジュール
'*** 「フォルダ名取得」ボタン
'***
'*** デフォルト値からフォルダを変更して表示する。
Public Sub SelectFolder()
Dim GetTargetFolderPathService As GetTargetFolderPathService
Set GetTargetFolderPathService = New GetTargetFolderPathService
Dim FolderPathFactory As FolderPathFactory
Set FolderPathFactory = New FolderPathFactory
Dim FolderPath As FolderPath
Set FolderPath = GetTargetFolderPathService.GetFromDialog(FolderPathFactory)
Dim DisplayFolderPathService As DisplayFolderPathService
Set DisplayFolderPathService = New DisplayFolderPathService
Call DisplayFolderPathService.DisplayFolderPath(FolderPath)
End Sub
'***「原本ブック取得」ボタン
'***
'***原本ブックを選択して取得する
Public Sub SelectGenponFolder()
Dim GetGenponPathService As GetGenponPathService
Set GetGenponPathService = New GetGenponPathService
Dim GenponBookGenponPolicy As IGenponPolicy
Set GenponBookGenponPolicy = New GenponBookGenponPolicy
Dim GenponBookLocatore As IBookLocator
Set GenponBookLocatore = New GenponBookLocatore
Dim FolderPathFactory As FolderPathFactory
Set FolderPathFactory = New FolderPathFactory
Dim GenponFolderPath As FolderPath
Set GenponFolderPath = GetGenponPathService.GetFromDialog(GenponBookGenponPolicy, GenponBookLocatore, FolderPathFactory)
Dim DisplayGenponBookName As DisplayGenponService
Set DisplayGenponBookName = New DisplayGenponService
Call DisplayGenponBookName.DisplayGenponName(GenponFolderPath, GenponBookGenponPolicy)
End Subフォルダの取得がうまくいけば、そのフォルダ内のブックや、指定した原本ブックなどを操作するきっかけになりそうですね。