нужен код VBA, чтобы удалить весь код после выполнения всего кода

Question

Мне нужен код VBA в Excel 2007, который удалит весь код VBA после выполнения всех функций. Я рисую пример здесь:

Option Explicit
Private Sub Workbook_Open()
'Runs a macro 10 seconds after Excel is opened
Call SaveBook
Application.OnTime Now + TimeValue("00:00:9"), "ThisWorkbook.SaveBook"
Application.OnTime Now + TimeValue("00:00:10"), "ThisWorkbook.Delete"
Application.OnTime Now + TimeValue("00:00:11"), "ThisWorkbook.Main"
End Sub


 Sub SaveBook()
ActiveWorkbook.Save
End Sub


Sub delete()
Dim NM As String
Dim CTS As Integer
Dim CNT2 As Integer
Dim CNT3 As Integer
CNT3 = 1
CNT2 = 1
CTS = Sheets.Count
Do Until CNT2 = CTS + 1
NM = Sheets(CNT3).Name
If Name = "Report" Then
Range("A1").Select
CNT3 = CNT3 + 1
Else
Sheets(NM).Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.delete
Application.DisplayAlerts = True
End If
CNT2 = CNT2 + 1
Loop
    End Sub
Sub Main()
    RemoveCodeFrom "Sheet3"
End Sub

Private Sub RemoveLinesFrom(vbCompName As String)
    Dim vbProj As VBIDE.VBProject
    Dim vbComp As VBIDE.VBComponent

    Set vbProj = ThisWorkbook.VBProject

    For Each vbComp In vbProj.VBComponents
        If StrComp(vbComp.Name, vbCompName, vbTextCompare) = 0 Then
            Dim CodeMod As VBIDE.CodeModule
            Set CodeMod = vbComp.CodeModule
            With CodeMod
                .DeleteLines 1, .CountOfLines
            End With
        End If
    Next

End Sub

Здесь все хорошо, но то, что мне нужно, что через 11 секунд весь код VBA будет удален. Является ли это возможным. Пожалуйста, помогите мне. Мне нужен код в целях безопасности моего файла. Я хочу защитить нежелательный доступ к моему файлу.

Answer 1

Если вам нужно сохранить макрос, используйте формат .xlsx , а не формат .xlsm :

Sub qwerty()
    Dim s As String
    s = Replace(ActiveWorkbook.FullName, "xlsm", "xlsx")
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=s, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Application.Quit
End Sub