另存新檔後不保留巨集

記得使用此副程式前，要勾選信任中心中的「信任存取VBA專案物件模型」！
Reference: https://www.mrexcel.com/forum/excel-questions/264140-savecopyas-without-macros.html

'信任中心：信任存取VBA專案物件模型(要打勾)
'※具有「縮小至右下角工具列」功能的程式，使用該模組會出錯！

Sub SaveWithoutMacros()
    
    'Purpose : To save a copy of the active workbook without macros
    
    Dim Filename As Variant
    Dim NoMacroActiveBook As Workbook
    Dim oVBComp As Object
    Dim oVBComps As Object
    
    On Error GoTo CodeError
    
    
    'Get a filename to save as
    
    Filename = ActiveWorkbook.Path & "\TEST_" & Format(Now, "yyyymmdd_hhmmss") & ".xls"
    
    ActiveWorkbook.SaveCopyAs Filename
    
    Set NoMacroActiveBook = Workbooks.Open(Filename)
    
    
    'Now strip all VBA, modules, userforms from the copy
    
    Set oVBComps = NoMacroActiveBook.VBProject.VBComponents
    
    For Each oVBComp In oVBComps
        Select Case oVBComp.Type
            Case 1, 2, 3 'Standard Module, Class Module, Userform
                oVBComps.Remove oVBComp
                
                'If you want to preserve some Module, uncomment the following line.
                'If oVBComp.Name <> "the module name you want to preserve" Then oVBComps.Remove oVBComp
                
            Case Else
                With oVBComp.CodeModule 'Worksheet or workbook code module
                    .DeleteLines 1, .CountOfLines
                End With
        End Select
    Next oVBComp
    
    Application.DisplayAlerts = False
    NoMacroActiveBook.Save
    NoMacroActiveBook.Close
    Application.DisplayAlerts = True
    
    MsgBox "A copy of your workbook has been created with all VBA code removed.", vbInformation, "Success!"
    
    Exit Sub
    
CodeError:
    MsgBox Err.Description, vbExclamation, "An Error Occurred"

End Sub