2013年8月18日日曜日

[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]使用例
at 0 件のコメント:
Labels:

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

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

[ソース]
''' <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]使用例
at 0 件のコメント:
Labels:

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

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

[ソース]
Option Explicit

''' <summary>
''' 指定したブック検索する。
''' </summary>
''' <param name="bookName">ブック名</param>
''' <returns>対象のWorkBook。（存在しない場合はNothing）</returns>
''' <remarks></remarks>
Public Function FindBook( _
    ByVal bookName As String) As 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]指定したブック内のシートを検索
at 0 件のコメント:
Labels:

2013年8月14日水曜日

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

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

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

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

  • 作者: 中 博俊
  • 出版社/メーカー: 技術評論社
  • 発売日: 2012/03/09
  • メディア: 単行本（ソフトカバー）
at 0 件のコメント:
Labels:
登録: 投稿 (Atom)

[雑記]ドローン（DJI Mini 3）

（１）雑記 もともと多趣味の友人 masakazu Drone 氏が、 最近、 ドローン にハマり始めて、 更に、新たな趣味が増えたとのこと。 ドローン を始めてから、 まだ1年も経っていないとのことですが、 旅行先で山や川の景色を 空撮 して、 Youtube ...

  • [雑記]ドローン（DJI Mini 3）
    （１）雑記 もともと多趣味の友人 masakazu Drone 氏が、 最近、 ドローン にハマり始めて、 更に、新たな趣味が増えたとのこと。 ドローン を始めてから、 まだ1年も経っていないとのことですが、 旅行先で山や川の景色を 空撮 して、 Youtube ...
  • [Book's Review (Develop)]Java言語で学ぶデザインパターン入門第３版
    （１）レビュー 　10年以上前からある書籍ですが、昨今のJavaのバージョンに合わせて、 　リニューアルされましたので、改めて紹介いたします。 　GOFが提唱したデザインパターンについて、とてもわかりやすくまとめた１冊です。 　各パターンを章毎にまとめてあり、クラス図・...
  • [SQLServer]sqlcmdコマンドの表示桁数の指定
    （１）はじめに 　 sqlcmd コマンドで、 　SELECTステートメントを実行した時、 　行の折り返しで、結果が見づらくなることがあります。 　 Oracle の LINESIZE に相当する設定が、 　 SQLServer にもないか調べてみました。 　普段...
  • [Hardware's Review]SEIKO CLOCK (セイコークロック) デジタル ウィークリーアラーム
    （１）レビュー 　目覚まし時計の調子が悪くなったので、新たに購入しました。 　指定した時刻にアラームが鳴ってくれさえすればよいので、 　特別な機能は求めていなかったのですが、 　価格の割に便利な機能が搭載されていたので、購入に至りました。 　最近は、スマホにもアラーム...
  • [Algo]和と積から元の２数の算出
    [はじめに] （１） ある２数の和と積から、元の２数を求めるアルゴリズム です。 　　　例えば、『 足して５ 』、『 掛けて６ 』になる２つの数は、 　　　 ２ と ３ になります。 　　　これを解くアルゴリズムとして、 　　　 ２次方程式の解の解法 を利用することがで...
  • [Book's Review (Develop)]ASP.NET MVC 5実践プログラミング
    （１）レビュー 　 ASP.NET は、以下の2種類に大別されます。 　 （１）ASP.NET Web Form 　　　.NET Framework1.0リリース時の頃から導入 　 （２）ASP.NET MVC 　　　.NET Framework4以降に導入 　...
  • [VBA]Excelのシートを並べ替え
    [はじめに] Excelでシートを昇順に並べ替える機会があったので、 備忘録としてサンプルソースを掲載します。 サンプルは昇順ソートですが、引数を変更すると降順にも対応できるようにしています。 [ソース] コードのコピー Optio...
  • [Book's Review (Develop)]独習JavaScript 新版
    （１）レビュー 　JavaScriptは古くからあり、時代と共に進化してきています。 　JavaScriptの独習シリーズは過去にもありましたが、 　最近（2021年）、独習シリーズでJavaScriptの新版が登場しました。 　 クラス 、 反復処理 、 非同期処理 ...
  • [.NET][Edge対応版]プログラムコードの変換（C#、VB.NET→HTML）
    [はじめに] 　・プログラムソース（C#、VB.NET）を 　　ブログ公開用のHTMLに変換するツールです。 　　（コード量が膨大の為、変換処理のみ掲載しています。） [機能] 　　プログラムソースの文字列を、HTMLに変換する。 　　変換後のHTMLは、<ta...
  • [Tool's Review]ステンレスものほし台 ブロー台付き BD-50S 【ブロー台付きで安定性抜群・U型の竿受けで竿の取り外し楽々! 】
    （１）レビュー 　最近、引越しをしました。 　ベランダの物干し竿を固定する位置が転居前よりも高く、 　身長が低い妻にとって家事がしづらいので、 　 物干し台 を購入しました。 　 　組み立て式の為、多少のぐらつきはありますが、 　実際使ってみても全く不便さを感じませ...