計算式やマクロを削除して、シートの値と書式だけをコピーした新しいExcelファイルを作成するVBAスクリプト

SaveAsValuesFormatsAndShapesNoMacrosNoButtons.vba

Sub SaveAsValuesFormatsAndShapesNoMacrosNoButtons()
    Dim ws As Worksheet
    Dim newWb As Workbook
    Dim newWs As Worksheet
    Dim originalFileName As String
    Dim saveFileName As String
    Dim shp As Shape
    Dim newShp As Shape

    ' 元のファイル名から拡張子を削除してファイル名を取得
    originalFileName = ThisWorkbook.Name
    saveFileName = Left(originalFileName, InStrRev(originalFileName, ".") - 1) & ".xlsx"
    
    ' 新しいワークブックを作成
    Set newWb = Workbooks.Add
    
    ' 各シートの処理
    For Each ws In ThisWorkbook.Sheets
        ' 新しいシートを作成してコピー
        Set newWs = newWb.Sheets.Add(After:=newWb.Sheets(newWb.Sheets.Count))
        ' シート名を元のシート名に設定
        newWs.Name = ws.Name
        ' セルの値とフォーマットをコピー
        ws.Cells.Copy
        newWs.Cells.PasteSpecial Paste:=xlPasteValues
        newWs.Cells.PasteSpecial Paste:=xlPasteFormats
        ' 列幅と行の高さをコピー
        newWs.Columns.ColumnWidth = ws.Columns.ColumnWidth
        newWs.Rows.RowHeight = ws.Rows.RowHeight
        ' 図形のコピー（ボタンなどのフォームコントロールを除外）
        For Each shp In ws.Shapes
            ' ボタンやフォームコントロールを除外
            If shp.Type <> msoFormControl And shp.Type <> msoOLEControlObject Then
                shp.Copy
                newWs.Paste
                Set newShp = newWs.Shapes(newWs.Shapes.Count)
                newShp.Top = shp.Top
                newShp.Left = shp.Left
                newShp.Width = shp.Width
                newShp.Height = shp.Height
            End If
        Next shp
    Next ws
    
    ' 最初のシートを削除 (初期作成シート)
    Application.DisplayAlerts = False
    newWb.Sheets(1).Delete
    Application.DisplayAlerts = True
    
    ' 元のファイル名を使用して保存
    newWb.SaveAs Filename:=ThisWorkbook.Path & "\" & saveFileName, FileFormat:=xlOpenXMLWorkbook
    newWb.Close
End Sub