[VBA]ファイル保存ダイアログの表示

[はじめに]
・最近、Excelマクロを使う機会が増えたので、
　備忘録としてサンプルを掲載します。
　VBAの関数が使いにくいので、クラスモジュールにまとめてみました。
　.NETのSaveFileDialogクラスを真似して実装しているので、
　.NET開発者にとっては、お馴染みのインタフェースで使いやすいかと思います。

[ソース]

コードのコピー

''' <summary> ''' クラスモジュール名：SaveFileDialog ''' ファイル保存ダイアログを制御するクラス ''' </summary> ''' <remarks></remarks> Option Explicit 'FileSystemPbject Private objFs As Object 'タイトル Public Title As String '初期ディレクトリ Public InitialDirectory As String '初期ファイル名 Public InitialFileName As String '[ファイルの種類]の選択肢 Public Filter As String '[ファイルの種類]の選択値 Public FilterIndex As Integer '選択したファイル名 Private m_FileName As String ''' <summary> ''' Initializeイベント（コンストラクタ） ''' </summary> ''' <remarks></remarks> Private Sub Class_Initialize()     Set objFs = CreateObject("Scripting.FileSystemObject")          Call Clear End Sub ''' <summary> ''' Terminateイベント（デストラクタ） ''' </summary> ''' <remarks></remarks> Private Sub Class_Terminate()     Set objFs = Nothing End Sub ''' <summary> ''' 初期化 ''' </summary> ''' <remarks></remarks> Public Sub Clear()          Me.InitialDirectory = Application.ThisWorkbook.path     Me.InitialFileName = ""     Me.Filter = "すべてのファイル(*.*),*.*"     Me.FilterIndex = 1     Me.Title = ""     m_FileName = "ファイル名を指定してください" End Sub ''' <summary> ''' フィルターを設定 ''' </summary> ''' <param name="filterArray">フィルター文字列</param> ''' <remarks></remarks> Public Sub SetFilterList(ParamArray filterArray() As Variant)     Filter = Join(filterArray, ",") End Sub ''' <summary> ''' 選択したファイル名を取得する。 ''' </summary> ''' <remarks></remarks> Public Function GetSelectedFileName() As String     GetSelectedFileName = m_FileName End Function ''' <summary> ''' パスとファイル名を結合する。 ''' </summary> ''' <param name="path">パス</param> ''' <param name="fileName">ファイル名</param> ''' <returns>結合後のフルパス</returns> ''' <remarks></remarks> Private Function BuildPath( _     ByVal path As String, _     ByVal fileName As String) As String          BuildPath = objFs.BuildPath(path, fileName) End Function ''' <summary> ''' ファイル保存ダイアログを開く ''' </summary> ''' <returns>vbOK：ファイル選択、vbCancel：キャンセル</returns> ''' <remarks></remarks> Public Function ShowDialog() As VbMsgBoxResult     Dim resDlg As Variant     Dim initDir As String          '初期ディレクトリの存在チェック     ' 存在しない場合は、Excelブックの配置ディレクトリに置き換える。     If objFs.FolderExists(Me.InitialDirectory) = False Then         Me.InitialDirectory = ThisWorkbook.path     End If          'ファイル選択ダイアログを開く     resDlg = _          Application.GetSaveAsFilename( _               InitialFileName:= _                 BuildPath( _                     Me.InitialDirectory, _                     Me.InitialFileName), _               FileFilter:=Me.Filter, _               FilterIndex:=Me.FilterIndex, _               Title:=Me.Title _              )     If resDlg = False Then         'キャンセルした場合         m_FileName = ""                  ShowDialog = vbCancel         Exit Function     End If          'ファイル選択した場合     m_FileName = resDlg          ShowDialog = vbOK     Exit Function      End Function

VBA]ファイル保存ダイアログ

[ソース]

コードのコピー

Private Sub CommandButton1_Click()     Dim sfd As New SaveFileDialog          With sfd         .InitialDirectory = "C:\Hoge"         .InitialFileName = "abc.csv"         .Title = "タイトル"         .FilterIndex = 1         .SetFilterList "CSV(*.csv),*.csv", "すべてのファイル(*.*),*.*"              End With          'ファイル保存ダイアログを開く。     If sfd.ShowDialog() = vbOK Then         MsgBox sfd.GetSelectedFileName()     Else         MsgBox "キャンセルしました"     End If          '終了処理     Set sfd = Nothing End Sub

VBA]使用例

タグ：ファイル保存ダイアログ VBA

コメント 1

相変わらず難しいね
by ちく (2013-08-31 00:34)