VBA代码删除代码,是自相残杀吗?非也,是定点清除,呵呵
言归正传,VBA是个不错的开发工具,一般情况下,程序猿开发测试代码之后,才会将Excel文件分发给最终的用户,此时代码已经保存在文件中,属于已经完成的静态代码。但是有时也需要用代码去产生(或者删除)代码。例如:用代码在工作表中动态添加ActiveX控件按钮,并添加按钮的Click事件代码。
Sub AddBtnAndCode()
Dim sCode, objBtn
With ActiveSheet
For Each obj In .OLEObjects
obj.Delete
Next obj
Set objBtn = .OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=120, Top:=50, Width:=130, Height:=30)
End With
sCode = "' *** Code Added By VBA ***" & vbCrLf & _
"Private Sub " & objBtn.Name & "_Click()" & vbCrLf & _
" MsgBox ""Hello""" & vbCrLf & _
"End Sub" & vbCrLf
With ActiveWorkbook.VBProject.VBComponents("sheet1").CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, sCode
End With
End Sub
代码中先使用OLEObjects.Add方法在工作表中添加一个按钮,由于按钮的名称会自动进行顺次编号,为了区别事件代码的正确,因此使用objBtn.Name获取按钮的名称,并生成事件代码字符串sCode,最后将代码插入到Sheet1的模块中。
接下来看看如何删除指定代码过程。假设现在需要删除Sheet1中的Change事件代码,首先需要定位Change事件代码在模块中的行号起止位置。找到事件代码的开始行后,记录行号为sNo,接下来首次定位到End Sub的行号作为结束行号eNo。
Sub DelSubCode()
Dim CodeInd As Long, sNo, eNo, bFlag
Const PROC_NAME = "PRIVATE SUB WORKSHEET_CHANGE(BYVAL TARGET AS RANGE)"
bFlag = False
With ActiveWorkbook.VBProject.VBComponents("sheet1").CodeModule
For CodeInd = .CountOfDeclarationLines + 1 To .CountOfLines
Select Case VBA.UCase$(Trim(.Lines(CodeInd, 1)))
Case PROC_NAME
bFlag = True
sNo = CodeInd
Case "END SUB"
If bFlag Then
eNo = CodeInd
Exit For
End If
End Select
Next CodeInd
' 逐行倒序删除
'For i = eNo To sNo Step -1
' .DeleteLines i
'Next
' 一次性删除整个过程代码
.DeleteLines sNo, eNo - sNo + 1
End With
End Sub
DeleteLines可以一次性删除多行代码,如果使用逐行删除代码的方式,一定要倒序删除。
注意:为了确保上述代码的运行,需要启用Excel【信任中心】>>【宏设置】中的“信任对VBA工程对象模型的访问”。