So-net無料ブログ作成

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

[はじめに]
・最近、Excelマクロを使う機会が増えたので、
 備忘録としてサンプルを掲載します。
 VBAの関数が使いにくいので、クラスモジュールにまとめてみました。
 クラスモジュールで定義することを前提としています。
 .NETのSaveFileDialogクラスのような使い方ができます。

[ソース]
コードのコピー
''' <summary>
''' クラスモジュール名:SaveFileDialog
''' ファイル保存ダイアログを制御するクラス
''' </summary>
''' <remarks></remarks>
Option Explicit

'FileSystemPbject
Private objFs As Object
'WScript.Shell
Private objWs 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")
    Set objWs = CreateObject("WScript.Shell")
    
    Call Clear
End Sub

''' <summary>
''' Terminateイベント(デストラクタ)
''' </summary>
''' <remarks></remarks>
Private Sub Class_Terminate()
    Set objFs = Nothing
    Set objWs = 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 CombinePath( _
    ByVal path As String, _
    ByVal fileName As StringAs String
    
    CombinePath = objFs.BuildPath(path, fileName)

End Function

''' <summary>
''' ファイル保存ダイアログを開く
''' </summary>
''' <returns>vbOK:ファイル選択、vbCancel:キャンセル</returns>
''' <remarks></remarks>
Public Function ShowDialog() As VbMsgBoxResult

    Dim resDlg As Variant
    
    'カレントディレクトリを設定
    objWs.CurrentDirectory = Me.InitialDirectory

    'ファイル選択ダイアログを開く
    resDlg = _
         Application.GetSaveAsFilename( _
              InitialFileName:= _
                CombinePath( _
                    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
        .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]使用例

nice!(0)  コメント(1)  トラックバック(0) 
共通テーマ:パソコン・インターネット

nice! 0

コメント 1

ちく

相変わらず難しいね[げっそり]
by ちく (2013-08-31 00:34) 

コメントを書く

お名前:[必須]
URL:
コメント:
画像認証:
下の画像に表示されている文字を入力してください。

※ブログオーナーが承認したコメントのみ表示されます。

トラックバック 0

メッセージを送る

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。