代码转换网站

http://www.developerfusion.com/tools

 

Sub 删除宏()
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
fname = ActiveWorkbook.Path & "\地球物理计算中心"
Set fd = fso.getfolder(fname)
Set fls = fd.Files
For Each fl In fls
    Set wb = Workbooks.Open(fname & "\" & fl.Name)
    Set pr = ActiveWorkbook.VBProject
    With pr
       'MsgBox "22"
        
        
        For i = .VBComponents.Count To 1 Step -1
                LCount = .VBComponents(i).CodeModule.CountOfLines
                .VBComponents(i).CodeModule.DeleteLines 1, LCount
                .VBComponents.Remove .VBComponents(i)
        Next i
    End With
    wb.Save
    wb.Close
Next

End Sub