以编程方式删除工作簿中带有宏的所有代码

Question

我需要使用宏删除工作簿中的所有代码。我正在使用此代码，似乎是pretty old。

Dim x As Integer
With ActiveWorkbook.VBProject
    For x = .VBComponents.Count To 1 Step -1
        .VBComponents.Remove .VBComponents(x)
    Next x
    For x = .VBComponents.Count To 1 Step -1
        .VBComponents(x).CodeModule.DeleteLines _
        1, .VBComponents(x).CodeModule.CountOfLines
    Next x
End With

我在.VBComponents.Remove .VBComponents(x)处遇到错误，Visual Basic在其中说：“运行时错误'5'：无效的过程调用或参数。”根据this page，此错误意味着我使用的过程错误，或者该过程不再存在。

如何修复此宏并使它与Office 2016兼容？

Answer 1

发生错误的原因不是由于代码太旧:)：P原因是您要删除所有模块...包括带有“ DeleteAllModules”：P ups的模块。顺便说一句，以防万一您需要将referencest设置为Microsoft Visual Basic应用程序可扩展性5.3并将安全性设置为“不安全”

有关详细信息，请转到https://www.google.pl/amp/s/christopherjmcclellan.wordpress.com/2014/10/10/vba-and-git/amp/

但只是为了快速解决

Option Explicit
'@Folder("DevTools") 

Const devTools As String = "devTools" 
'This is the name of module with "RemoveAllModules" and it will be ignored

Private Sub RemoveAllModules()
Dim comp As VBComponent

 For Each comp In Application.VBE.ActiveVBProject.VBComponents
  If comp.Type = vbext_ct_ClassModule Or comp.Type = vbext_ct_StdModule Then
        If Not comp.name = devTools Then
            Application.VBE.ActiveVBProject.VBComponents.Remove comp
        End If
    End If
 Next

End Sub

Answer 2

就像sous2187所说，最好的方法是将文件另存为非宏文件，然后让excel删除宏本身。所以我就是这么做的。

Sub delhiddensheets()

    For Each sh In Worksheets
        If sh.Visible = xlSheetHidden Then
            sh.Delete
        End If
    Next sh

End Sub

Sub Valuepaste()

    Dim tabs As Object
    For Each tabs In Sheets
        With tabs
            If .Visible = True Then .Select Replace:=False
        End With
    Next tabs
    Cells.Select
    Range("A1").Activate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A20").Select

End Sub

Sub DeleteAllCode()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    newname = Left(ActiveWorkbook.Name, (InStrRev(ActiveWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_VALS.xlsx"
    ChDir ActiveWorkbook.Path
    ActiveWorkbook.SaveAs Filename:=newname, FileFormat:=xlOpenXMLWorkbook
    Valuepaste
    delhiddensheets

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True

End Sub