Excel文档VBA代码自动删除

有时候，不想让自己编写的代码让别人长期使用或换地方使用，又不想让文档自杀，就可以设计限期清除代码，或其他限制条件下清除。具体限制条件可参考博主《Excel文档自杀程序设计》Workbook_Open模块那一部分。代码清除后，与代码有关的程序就不能运行了。

如设置2011年12月31日后打开文档就清除代码，可以这样设计：

Private Sub Workbook_Open()   ’这个程序一定要在Thisworkbook模块中

On Error Resume Next

If Date>40908 then Then Call 删除代码

End Sub                                                  

删除代码的程序是

Sub 删除代码()   ’这个程序要在标准的Moudle模块中

For i = 1 To ActiveWorkbook.VBProject.VBComponents.Count ActiveWorkbook.VBProject. 

    VBComponents(i).CodeModule.DeleteLines 1, _
    ActiveWorkbook.VBProject.VBComponents(i).CodeModule.CountOfLines

Next i

End Sub                                                  

如果要把窗体、模块、类模块一并删除可改为一下代码

Sub 删除代码()   ’这个程序要在标准的Moudle模块中最好

For i = 1 To ActiveWorkbook.VBProject.VBComponents.Count ActiveWorkbook.VBProject. 

    VBComponents(i).CodeModule.DeleteLines 1, _
    ActiveWorkbook.VBProject.VBComponents(i).CodeModule.CountOfLines

Next i

Dim Vbc As Object

For Each Vbc In Application.ThisWorkbook.VBProject.VBComponents

    Select Case Vbc.Type

    Case 1, 2, 3

         With Application.VBE.ActiveVBProject.VBComponents

         .Remove .Item(Vbc.Name)    ’移除模块、类模块、窗体

         End With

     End Select

  Next

End sub                                 

  “删除代码”这几个字太显眼，使用时可改为其他英文字母代替程序名称，如拼音SCDM等。

一般在打开文档时设置限定清除代码条件，也可在关闭文件时设置限定条件。

   如果你设置了工程密码保护，那么在运行上程序时就会出错。代码就删除不了。因此就要添加VBA工程解除密码保护程序。修改后程序具体设置如下：

Private Sub Workbook_Open()  '这个程序一定要在Thisworkbook模块中

On Error Resume Next

If Date>40908 then Then Call 删除代码

End Sub                                                  

Sub 删除代码()   '这个程序要在标准的Moudle模块中最好

解除工程保护  '引用本模块的解除保护程序

 For i = 1 To ActiveWorkbook.VBProject.VBComponents.Count ActiveWorkbook.VBProject. 

   VBComponents(i).CodeModule.DeleteLines 1, _
 ActiveWorkbook.VBProject.VBComponents(i).CodeModule.CountOfLines

Next i

Dim Vbc As Object

For Each Vbc In Application.ThisWorkbook.VBProject.VBComponents

    Select Case Vbc.Type

    Case 1, 2, 3

         With Application.VBE.ActiveVBProject.VBComponents

         .Remove .Item(Vbc.Name)  ’移除模块、类模块、窗体

         End With

     End Select

  Next

End Sub                                                   

Sub 解除工程保护()   ' 这个程序也要在标准的Moudle模块中

  Dim strPassWord As String

  Application.VBE.MainWindow.Visible = False

  strPassWord = "123"   ’ 引号里面必须是你的真实的工程保护密码

  Application.VBE.CommandBars.FindControl(ID:=2578).Execute

  SendKeys strPassWord & "{enter}{tab}{enter}"

  DoEvents

End Sub                                                         

程序不是很稳定，有时候会出现错误，这也可能是Excel内部原因。该程序只能删除全部代码，如果只想删除某一部分代码，可自行研究删除代码部分内容。

zqqxx@126.com