シート単体を別ブックとして保存する

<概要>

　今回は、シート単体を別ブックとして保存する汎用プロシージャを紹介します。

　Excelブック内にある特定のシート（ワークシート）単体だけを別ブックで出力するような処理を実装するときに用います。

　この時に考慮すべきが次のような事項です。

・そのシートにマクロを実行するボタンがある場合は邪魔になるので消去する（引数 DeleteButtonで設定）

・シート内で別シートを参照する数式が入っていると、出力後に外部ブック参照になってしまうので、値のベタ打ちに変換する（引数 ConvFormulaValueで設定）

・ブック出力後に何らかの処理を行う（返り値は出力ブックとして参照可能）

　これらのような事項も引数で調整できるような汎用プロシージャとして設計しております。

<用途>

• シート単体を別ブックとして保存する

<プロシージャ紹介>

Public Function SaveSheetAsBook(Sheet As Worksheet, [SaveName As String], [SavePath As String], [DeleteButton As Boolean = True], [Message As Boolean = False], [ConvFormulaValue As Boolean = False], [CloseBook As Boolean = True]) As Workbook

名前： SaveSheetAsBook /Functionプロシージャ

説明： 指定のシートを別ブックで保存する

引数

Sheet ・・・対象のシート

[SaveName] ・・・保存ブック名(省略なら対象シートの名前)

[SavePath] ・・・保存先フォルダパス(省略なら対象シートのブックのフォルダパス)

[DeleteButton] ・・・コマンドボタンを消去するか(省略なら消去)

[Message] ・・・メッセージを表示するか(省略なら表示しない)

[ConvFormulaValue]・・・数式を値に変換するかどうか(省略なら変換しない)

[CloseBook] ・・・保存したブックを閉じるかどうか(省略なら閉じる)

<実行例>

　次のようなコードを用意します。

　なおOneDriveの影響も考慮してConvOneDrivePath_LocalPathプロシージャを利用しています。

Public Sub TestSaveSheetAsBook()
    Dim Sheet    As Worksheet: Set Sheet = Sheet2
    Dim SaveName As String: SaveName = "シート保存テスト"
    Dim SavePath As String: SavePath = ThisWorkbook.Path
    SavePath = ConvOneDrivePath_LocalPath(SavePath)
    
    Call SaveSheetAsBook(Sheet, SaveName, SavePath)
    
End Sub

　実行するとSheet2オブジェクトが「シート保存テスト.xlsx」で出力されます。

<サンプルファイル>

SaveSheetAsBook.zip

ダウンロード：ZIP • 21KB

<コード>

Gist

'SaveSheetAsBook    ・・・元場所：IkiAddin.ModFile
'DeleteButtonOnSheet・・・元場所：IkiAddin.ModShape

Public Function SaveSheetAsBook(ByRef Sheet As Worksheet, _
                    Optional ByRef SaveName As String, _
                    Optional ByRef SavePath As String, _
                Optional ByRef DeleteButton As Boolean = True, _
                     Optional ByRef Message As Boolean = False, _
            Optional ByRef ConvFormulaValue As Boolean = False, _
                   Optional ByRef CloseBook As Boolean = True) _
                                            As Workbook
              
'指定のシートを別ブックで保存する
'20210719作成
'20220223 ボタンの消去機能追加
'20221013 マクロ付きブックをxlsxで保存する際の警告メッセージ無視
'20231129 出力したブックをWorkbookオブジェクトとして返す機能追加
'https://www.softex-celware.com/post/savesheetasbook

'引数
'Sheet             ・・・対象のシート
'[SaveName]        ・・・保存ブック名(省略なら対象シートの名前)
'[SavePath]        ・・・保存先フォルダパス(省略なら対象シートのブックのフォルダパス)
'[DeleteButton]    ・・・コマンドボタンを消去するか(省略なら消去)
'[Message]         ・・・メッセージを表示するか(省略なら表示しない)
'[ConvFormulaValue]・・・数式を値に変換するかどうか(省略なら変換しない)
'[CloseBook]       ・・・保存したブックを閉じるかどうか(省略なら閉じる)

    '入力引数の調整
    If SaveName = "" Then
        SaveName = Sheet.Name
    End If
    If SavePath = "" Then
        SavePath = Sheet.Parent.Path
    End If
    
    'シートをコピー
    Sheet.Copy
    Dim SaveSheet As Worksheet: Set SaveSheet = ActiveWorkbook.Sheets(1)
    
    '数式を値に変換
    If ConvFormulaValue = True Then
        Dim Cell As Range
        For Each Cell In SaveSheet.UsedRange
            If Cell.HasFormula = True Then
                Cell.Value = Cell.Value
            End If
        Next
    End If
    
    'シート上のボタン消去
    If DeleteButton = True Then
        Call DeleteButtonOnSheet(SaveSheet)
    End If
    
    Application.DisplayAlerts = False '20221013
    ActiveWorkbook.SaveAs SavePath & "\" & SaveName
    If CloseBook = True Then
        ActiveWorkbook.Close
    Else
        Set SaveSheetAsBook = ActiveWorkbook
    End If
    Application.DisplayAlerts = True '20221013
    
    If Message Then
        MsgBox "シート名「" & Sheet.Name & "」を" & vbLf & _
               "「" & SavePath & "」に" & vbLf & _
               "ファイル名「" & SaveName & "」で保存しました。", vbInformation
    End If
    
End Function

Private Sub DeleteButtonOnSheet(Sheet As Worksheet)
'コマンドボタンのみ消去する
'20220223
    
    Dim Shape As Shape
    For Each Shape In Sheet.Shapes
        If Shape.Type = msoFormControl Then
            Shape.Delete
        End If
    Next 
End Sub