MW211 EXIT

devlog
ExcelVBA/シートをファイル出力するクラス
2018年07月23日
┌──────────────────────────────────────┐
│Option Explicit                                                             │
│'***************************************************************************│
│'  クラス:ファイル出力                                                     │
│'***************************************************************************│
│Private m出力シート As Worksheet                                            │
│'===========================================================================│
│'  コンストラクタ                                                           │
│'===========================================================================│
│Private Sub Class_Initialize()                                              │
│End Sub                                                                     │
│'===========================================================================│
│'  メソッド:準コンストラクタ                                               │
│'===========================================================================│
│Public Sub 準コンストラクタ(ByVal 出力シート名 As String)                   │
│    Set m出力シート = ThisWorkbook.Worksheets(出力シート名)                 │
│End Sub                                                                     │
│'===========================================================================│
│'  デストラクタ                                                             │
│'===========================================================================│
│Private Sub Class_Terminate()                                               │
│End Sub                                                                     │
│'===========================================================================│
│'  実行:ファイル出力                                                       │
│'===========================================================================│
│Private Sub 実行()                                                          │
│    Dim 出力先 As Variant                                                   │
│    ' 出力先選択                                                            │
│    出力先 = 出力先選択()                                                   │
│    If 出力先 = "" Then                                                     │
│        Exit Sub                                                            │
│    End If                                                                  │
│    ' 複写                                                                  │
│    m出力シート.Copy                                                        │
│    ' 保存                                                                  │
│    Application.DisplayAlerts = False   ' 確認ダイアログ抑止(強制上書)      │
│    ActiveWorkbook.SaveAs Filename:=出力先, _                               │
│                          FileFormat:=XlFileFormat.xlOpenXMLWorkbook        │
│    Application.DisplayAlerts = True    ' 確認ダイアログ抑止解除            │
│    ActiveWorkbook.Close SaveChanges:=False                                 │
│End Sub                                                                     │
│'===========================================================================│
│'  内部メソッド:出力先選択                                                 │
│'===========================================================================│
│Private Function 出力先選択() As String                                     │
│    Dim メッセージ As String                                                │
│    Dim 出力先 As Variant                                                   │
│    Dim ファイル名 As String                                                │
│    ファイル名 = ファイル名編集(m出力シート.Name) & ".xlsx" ' 初期表示      │
│    Do                                                                      │
│        出力先 = Application.GetSaveAsFilename( _                           │
│            InitialFileName:=ファイル名, _                                  │
│            FileFilter:="Excelファイル(*.xlsx),*.xlsx" _                    │
│        )                                                                   │
│        ' キャンセル                                                        │
│        If 出力先 = False Then                                              │
│            MsgBox "キャンセルされました。", vbInformation, "処理の中止"    │
│            出力先選択 = ""                                                 │
│            Exit Function                                                   │
│        End If                                                              │
│        ' 新規追加                                                          │
│        If Dir(出力先) = "" Then                                            │
│            Exit Do                                                         │
│        End If                                                              │
│        ' 上書の確認                                                        │
│        ファイル名 = Dir(出力先)                                            │
│        メッセージ = ファイル名 & " は既に存在します。" & vbCrLf _          │
│                   & "上書きしますか?"                                     │
│        If MsgBox(メッセージ, vbYesNo + vbExclamation, "処理の確認") _      │
│                                                                = vbYes Then│
│            Exit Do                                                         │
│        End If                                                              │
│    Loop                                                                    │
│    出力先選択 = 出力先                                                     │
│End Function                                                                │
│'===========================================================================│
│'  内部メソッド:ファイル名編集  ファイル使用不可文字を置換                 │
│'===========================================================================│
│Private Function ファイル名編集(ByVal ファイル名 As String) As String       │
│    ファイル名 = Replace(ファイル名, "<", "(")                              │
│    ファイル名 = Replace(ファイル名, ">", ")")                              │
│    ファイル名編集 = ファイル名                                             │
│End Function                                                                │
│'***************************************************************************│
└──────────────────────────────────────┘
シートをファイル出力するクラスも作ってみた。

以下のようにして使う。
┌──────────────────────────────────────┐
│Dim objファイル出力 As New Classファイル出力                                │
│Call objファイル出力.準コンストラクタ("出力")  ' 任意のシート名を指定       │
│Call objファイル出力.実行()                                                 │
└──────────────────────────────────────┘
分類:ExcelVBA