目次
解決の糸口は、マイクロソフトの公式ページに!
こちらに解決の糸口となる情報が書かれていました。
VBA コードと Apple Script を組み合わせて使用すれば、同じ操作を実行できます。これを行うには、次の説明に従って、Apple Script 文字列を作成し、その文字列を VBA MacScript 関数と実行します。
マイクロソフト公式ページ
どうやらVBAコードとApple Scriptを組み合わせれば、MacでもGetOpenFilenameでワイルドカードを使用したり、複数ファイルを選択したりすることが可能になる、とのこと。
サンプルコードはそのまま使える?
' Windowsでファイル選択ダイアログを表示する
Sub Select_File_Or_Files_Windows()
Dim SaveDriveDir As String
Dim MyPath As String
Dim Fname As Variant
Dim N As Long
Dim FnameInLoop As String
Dim mybook As Workbook
' Save the current directory.
SaveDriveDir = CurDir
' Set the path to the folder that you want to open.
MyPath = Application.DefaultFilePath
' You can also use a fixed path.
'MyPath = "C:\Users\Ron de Bruin\Test"
' Change drive/directory to MyPath.
ChDrive MyPath
ChDir MyPath
' Open GetOpenFilename with the file filters.
Fname = Application.GetOpenFilename( _
FileFilter:="Excel 97-2003 Files (*.xls), *.xls", _
Title:="Select a file or files", _
MultiSelect:=True)
' Perform some action with the files you selected.
If IsArray(Fname) Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
For N = LBound(Fname) To UBound(Fname)
' Get only the file name and test to see if it is open.
FnameInLoop = Right(Fname(N), Len(Fname(N)) - InStrRev(Fname(N), Application.PathSeparator, , 1))
If bIsBookOpen(FnameInLoop) = False Then
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(Fname(N))
On Error GoTo 0
If Not mybook Is Nothing Then
MsgBox "You opened this file : " & Fname(N) & vbNewLine & _
"And after you press OK, it will be closed" & vbNewLine & _
"without saving. You can replace this line with your own code."
mybook.Close SaveChanges:=False
End If
Else
MsgBox "We skipped this file : " & Fname(N) & " because it is already open."
End If
Next N
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
' Change drive/directory back to SaveDriveDir.
ChDrive SaveDriveDir
ChDir SaveDriveDir
End Sub
' Macでファイル選択ダイアログを表示する
Sub Select_File_Or_Files_Mac()
Dim MyPath As String
Dim MyScript As String
Dim MyFiles As String
Dim MySplit As Variant
Dim N As Long
Dim Fname As String
Dim mybook As Workbook
On Error Resume Next
MyPath = MacScript("return (path to documents folder) as String")
'Or use MyPath = "Macintosh HD:Users:Ron:Desktop:TestFolder:"
' In the following statement, change true to false in the line "multiple
' selections allowed true" if you do not want to be able to select more
' than one file. Additionally, if you want to filter for multiple files, change
' {""com.microsoft.Excel.xls""} to
' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""}
' if you want to filter on xls and csv files, for example.
MyScript = _
"set applescript's text item delimiters to "","" " & vbNewLine & _
"set theFiles to (choose file of type " & _
" {""com.microsoft.Excel.xls""} " & _
"with prompt ""Please select a file or files"" default location alias """ & _
MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
"set applescript's text item delimiters to """" " & vbNewLine & _
"return theFiles"
MyFiles = MacScript(MyScript)
On Error GoTo 0
If MyFiles <> "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
MySplit = Split(MyFiles, ",")
For N = LBound(MySplit) To UBound(MySplit)
' Get the file name only and test to see if it is open.
Fname = Right(MySplit(N), Len(MySplit(N)) - InStrRev(MySplit(N), Application.PathSeparator, , 1))
If bIsBookOpen(Fname) = False Then
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MySplit(N))
On Error GoTo 0
If Not mybook Is Nothing Then
MsgBox "You open this file : " & MySplit(N) & vbNewLine & _
"And after you press OK it will be closed" & vbNewLine & _
"without saving, replace this line with your own code."
mybook.Close SaveChanges:=False
End If
Else
MsgBox "We skipped this file : " & MySplit(N) & " because it Is already open."
End If
Next N
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub
' Windowsでファイル選択ダイアログを表示する
Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Contributed by Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
早速参考リンク先にあるコードを使ってみようとしたところ、そのまま使えないことが発覚!
Windowsにしろ、Macにしろ、選択したファイル名を取得できるようにちょっと工夫してあげる必要があるようです。
まず、選択するファイルがxlsではなく、xlsxの場合には赤色マーカーの部分をWindows・Macの両方を修正する必要があります。
また、今回はあえてそれぞれのプロシージャー内で処理を完結させるつもりがないため、選択した情報を戻り値として取得するように変更します。
最後の一工夫
けれど、それでもまだ工夫が必要だということがわかりました。
Macの方でファイルを複数選択しても、サンプルコードでもファイルが開かれなかったのです。
![](https://hajimarinomachi.com/wp-content/uploads/2022/03/スクリーンショット-2022-03-28-21.46.29.png)
デバッグで確認してみて検証した結果、どうやら原因は2つありました。
- フルパスではなく、先頭のMacintosh HDが不要であること
- : ではなく、/ にする。
最終コード:使っているOSによって処理を切り分ける
ということで、最終的なコードは下記のようになりました。ただし、Windows版がまだ試せていませんので、来週確認できるので確認でき次第ご報告します。
(4/19追記)
Windows版でも確認できましたので、Windowsの箇所についてコードを修正しました。
Sub test2()
Dim openWb As Workbook
Dim openFileName As Variant, fileName As Variant
' Windows版かMac版かによって処理を分けて、ファイルを複数選択する
openFileName = WINorMAC
If Not Application.OperatingSystem Like "*Mac*" Then
' Windows
If IsEmpty(openFileName) Then
MsgBox "キャンセルされました"
Exit Sub
End If
Else
' Mac
If openFileName = "" Then
MsgBox "キャンセルされました"
Exit Sub
Else
' 文字列をカンマで区分けして、配列に格納する
openFileName = Split(openFileName, ",")
End If
End If
' 選択したファイルを開く
For Each fileVar In openFileName
If Application.OperatingSystem Like "*Mac*" Then
fileVar = Replace(Replace(fileVar, ":", "/"), "Macintosh HD", "")
End If
Workbooks.Open fileVar
Set openWb = ActiveWorkbook
' 処理を書く
Application.DisplayAlerts = False
openWb.Close
Application.DisplayAlerts = True
Next fileVar
End Sub
※青色マーカーの箇所の部分については、本来openFileName = Falseかと思いますが・・・
ファイルを選択しなかった場合は、Macの場合空欄(””)で値が返ってくるので、このように設定します。
(4/19追記)
ちなみに、Windowsの場合には、ファイルを選択しなかった場合はEmptyが返ってくるので、IsEmptyで判別するようにします。
' WindowsとMacで切り分けるプロシージャー
Function WINorMAC() As Variant
Dim MyFiles As Variant
' Test for the operating system.
If Not Application.OperatingSystem Like "*Mac*" Then
' Is Windows.
MyFiles = Select_File_Or_Files_Windows
Else
' Is a Mac and will test if running Excel 2011 or higher.
If Val(Application.Version) > 14 Then
MyFiles = Select_File_Or_Files_Mac
End If
End If
' 選択したファイルを戻り値に設定する
WINorMAC = MyFiles
End Function
' Windowsでファイル選択ダイアログを表示する
Function Select_File_Or_Files_Windows()
Dim SaveDriveDir As String
Dim MyPath As String
Dim Fname As Variant
Dim N As Long
Dim FnameInLoop As String
Dim mybook As Workbook
' Save the current directory.
SaveDriveDir = CurDir
' Set the path to the folder that you want to open.
MyPath = Application.DefaultFilePath
' Change drive/directory to MyPath.
ChDrive MyPath
ChDir MyPath
' Open GetOpenFilename with the file filters.
Fname = Application.GetOpenFilename( _
FileFilter:="Excel File, *.xls*", _
Title:="Select a file or files", _
MultiSelect:=True)
' Change drive/directory back to SaveDriveDir.
ChDrive SaveDriveDir
ChDir SaveDriveDir
' 選択したファイルを戻り値に設定する
Select_File_Or_Files_Windows = Fname
End Function
' Macでファイル選択ダイアログを表示する
Function Select_File_Or_Files_Mac() As Variant
Dim MyPath As String
Dim MyScript As String
Dim MyFiles As String
Dim MySplit As Variant
Dim N As Long
Dim Fname As String
Dim mybook As Workbook
On Error Resume Next
MyPath = MacScript("return (path to documents folder) as String")
'Or use MyPath = "Macintosh HD:Users:Ron:Desktop:TestFolder:"
' In the following statement, change true to false in the line "multiple
' selections allowed true" if you do not want to be able to select more
' than one file. Additionally, if you want to filter for multiple files, change
' {""com.microsoft.Excel.xls""} to
' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""}
' if you want to filter on xls and csv files, for example.
MyScript = _
"set applescript's text item delimiters to "","" " & vbNewLine & _
"set theFiles to (choose file of type " & _
" {""org.openxmlformats.spreadsheetml.sheet""} " & _
"with prompt ""Please select a file or files"" default location alias """ & _
MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
"set applescript's text item delimiters to """" " & vbNewLine & _
"return theFiles"
MyFiles = MacScript(MyScript)
On Error GoTo 0
' 選択したファイルを戻り値に設定する
Select_File_Or_Files_Mac = MyFiles
End Function
' Windowsでファイル選択ダイアログを表示する
Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Contributed by Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
いかがでしたでしょうか?
「Mac VBA ファイル 複数選択できない」とGoogleで検索しても、上位3ページにはそもそもMacに関する情報はほとんど表示されず。
しかも、表示されたページでは、Macで使用するGetOpenFilenameメソッドについてこのように書かれている記事ばかり。
「ワイルドカードの使用できない」
「ファイルの複数選択できない」
あと、だいたいMacのマクロは使えないという記事ばかり。
ぼくもずっとそう思っていました。
けれど、一番使いたかったGetOpenFilenameメソッドの活用だけでなく、日本語入力の位置ずれ問題も解消できたことで、ぼくが作成するほとんどのマクロはMacで事足りるようになりました(^^)v
同じような悩みを持っている方にとって、解決の助けになれば幸いです。
最後まで読んでいただき、ありがとうございました!
①日本語入力の位置ずれ問題→エディッターの設定でフォントを変更する
②ダイアログで複数ファイル選択不可→VBA コードと Apple Script を組み合わせて使用する
一つ目は、
侍エンジニア塾
です。
VBAやJavaScript関連でネット検索したことがある方であれば、一度は見かけたことある名前かと思います。
JavaやPython、C言語、VBA、JavaScriptなど、様々なプログラミング言語をオンラインで習得するためのサービスを提供しているところなので、自分が習得したい言語がもしありましたら、無料体験レッスンを受けてみると良いかもしれません。
そこでプロ講師に相談をして、習得するプログラミング言語に対して直接質問するのがベストです。
![](http://image.moshimo.com/af-img/0665/000000047711.jpg)
ストアカ
![](https://www10.a8.net/0.gif?a8mat=3Z0X31+9CZDY2+352U+5YJRM)
です。
こちらはあえてプログラミング学習専門ではなく、もっと手軽に学ぶ機会を得るサービスをチョイスしてみました。
VBAやJavaScriptなどのワンツーマンレッスンを開催している講師が多数登録しているので、まずは出費を抑えて学習したいと考えている方にお勧めです。
![](https://www16.a8.net/0.gif?a8mat=3Z0X31+9CZDY2+352U+62MDD)