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'：无效的过程调用或参数。”根据{{3}}，这个错误意味着我正在使用我的程序错误，或者此程序不再存在。

如何修复此宏并使其适用于Office 2016？

Answer 1

错误的原因不是由于代码老了:)：P原因是你要删除所有模块......包括带有“DeleteAllModules”的模块：P ups。顺便说一下，如果你需要设置参考 Microsoft Visual Basic for Applications Extensibility 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所说，最好的方法是将文件保存为nonmacro文件，然后让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

以Progrmatically方式删除所有代码

2 个答案: