执行完所有代码后需要vba代码删除所有代码

执行完所有代码后需要vba代码删除所有代码

我需要一个 Excel 2007 中的 vba 代码,它将在执行完所有函数后删除所有 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 代码。这可能吗?请帮帮我。我需要代码来保护我的文件的安全。我想保护对我的文件的不必要的访问。

答案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

相关内容