SaveSheetAsBook

'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