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]使用例

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

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

[ソース]
コードのコピー
''' <summary>
''' クラスモジュール名:OpenFileDialog
''' ファイル選択ダイアログを制御するクラス
''' </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 Filter As String
'[ファイルの種類]の選択値
Public FilterIndex As Integer
'複数選択の可否
Public MultiSelect As Boolean

'選択したファイル名
Private m_FileNames() 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.Filter = "すべてのファイル(*.*),*.*"
    Me.FilterIndex = 1
    Me.Title = "ファイルを選択してください"
    Me.MultiSelect = True

    ReDim m_FileNames(0)
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 GetSelectedFileNames() As String()
    GetSelectedFileNames = m_FileNames
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.GetOpenFilename( _
              FileFilter:=Me.Filter, _
              FilterIndex:=Me.FilterIndex, _
              Title:=Me.Title, _
              MultiSelect:=Me.MultiSelect _
             )

    If IsArray(resDlg) = False Then
        If resDlg = False Then
            'キャンセルした場合
            ReDim m_FileNames(0)
            
            ShowDialog = vbCancel
            Exit Function
        End If
    End If
    
    ReDim m_FileNames(0)
    
    'ファイル選択した場合
    If IsArray(resDlg) = True Then
        '複数選択の場合
        Dim cnt_i As Integer
        
        For cnt_i = 1 To UBound(resDlg)
            ReDim Preserve m_FileNames(cnt_i - 1)
            m_FileNames(cnt_i - 1) = resDlg(cnt_i)
        Next
        
        ShowDialog = vbOK
        Exit Function
    Else
        '単一選択の場合
        ReDim m_FileNames(0)
        m_FileNames(0) = resDlg
    
        ShowDialog = vbOK
        Exit Function
    End If
    
End Function
[VBA]ファイル選択ダイアログ

[ソース]
コードのコピー
Private Sub CommandButton1_Click()
    
    Dim ofd As New OpenFileDialog
    
    With ofd
        .Title = "ファイル選択ダイアログ(単一選択)"
        .FilterIndex = 1
        .MultiSelect = False
        .SetFilterList "CSV(*.csv),*.csv""すべてのファイル(*.*),*.*"
        
    End With
    
    'ファイル選択ダイアログを開く。
    If ofd.ShowDialog() = vbOK Then
        
        Dim cntI As Integer
        Dim fList() As String
        
        fList = ofd.GetSelectedFileNames()
        
        For cntI = 0 To UBound(fList)
            MsgBox fList(cntI)
        Next
    Else
        MsgBox "キャンセルしました"
    End If

    '終了処理
    Set ofd = Nothing

End Sub
[VBA]使用例

[VBA]指定したブック内のシート検索 [Programming ExcelVBA]

[はじめに]
・最近、Excelマクロを使う機会が増えたので、備忘録としてサンプルを掲載します。
 指定したブック内のシートを検索する処理です。

[ソース]
コードのコピー
Option Explicit

''' <summary>
''' 指定したブック検索する。
''' </summary>
''' <param name="bookName">ブック名</param>
''' <returns>対象のWorkBook。(存在しない場合はNothing)</returns>
''' <remarks></remarks>
Public Function FindBook( _
    ByVal bookName As StringAs Workbook

    Dim bk As Workbook
    
    For Each bk In Workbooks
        If bk.name = bookName Then
            Set FindBook = Workbooks(bk.name)
            Exit Function
        End If
    Next

End Function

''' <summary>
''' 指定したブック内のシートを検索する。
''' </summary>
''' <param name="sheetName">シート名</param>
''' <param name="bookName">ブック名(※省略時はThisWorkbook.Name)</param>
''' <returns>対象のWorkSheet。(存在しない場合はNothing)</returns>
''' <remarks></remarks>
Public Function FindSheet( _
    ByVal sheetName As String, _
    Optional ByVal bookName As String = ""As Worksheet

    Dim bk As Workbook
    Dim sht As Worksheet

    If bookName = "" Then
        'ブック名を省略した場合は、
        '自分自身のブックを対象とする。
        Set bk = ThisWorkbook
    Else
        Set bk = FindBook(bookName)
        
        If bk Is Nothing Then
            '指定したブック名が存在しない場合は、Nothingを返す。
            Set FindSheet = Nothing
            Exit Function
        End If
        
    End If
    
    For Each sht In bk.Sheets
        If sht.name = sheetName Then
            Set FindSheet = bk.Worksheets(sht.name)
            Exit Function
        End If
    Next

    'シートが存在しない場合、Nothingを返す。
    Set FindSheet = Nothing

End Function
[VBA]指定したブック内のシートを検索

[Review]〔速攻入門〕 C#プログラミング すぐに現場で使える知識 [Book's Review (Develop)]

(1)レビュー
 JavaやC++の経験者向けのC#の入門書です。
 経験者向けの為、プログラミングの基礎知識の説明は割愛しています。
 その分、類似機能について他言語(Java、C++)との比較を交えたり等、
 より深い技術の解説が充実しています。
 本書の執筆時点では、
 .NET Framework4(C#4.0、VisualStudio2010)が最新版ですが、
 プレビュー版ですが、.NET Framework4.5(C#5.0)も紹介しています。

(2)リンク
〔速攻入門〕 C#プログラミング すぐに現場で使える知識

〔速攻入門〕 C#プログラミング すぐに現場で使える知識

  • 作者: 中 博俊
  • 出版社/メーカー: 技術評論社
  • 発売日: 2012/03/09
  • メディア: 単行本(ソフトカバー)

メッセージを送る

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