'
'removeExcelMacro("Book1.Xls",Array("CheckBox1","TextBox1","ListBox"))
'
'直接删除目标文件的宏代码和控件(可选择保留的控件),Excel文件名称、要删除的控件名称数组
Public Static Function removeExcelMacro(targetExcelFileName As String, killOleObjectType As Variant) As Boolean
On Error GoTo ErrHand
Dim i, j, n As Byte
Dim vbeComp As New VBComponents
Dim vbaObje As OLEObject
removeExcelMacro = False
Set vbeComp = Application.Workbooks(targetExcelFileName).VBProject.VBComponents
n = vbeComp.Count
For i = 1 To n
If i > vbeComp.Count Then Exit For
If vbeComp(i).Type = 100 Then ' 100: xl_Document_Type(Include Workbook , Worksheet)
'删除代码
If vbeComp(i).CodeModule.CountOfLines > 0 Then vbeComp(i).CodeModule.DeleteLines 1, vbeComp(i).CodeModule.CountOfLines
'删除控件
vbeComp(i).Activate
If killOleObjectType(0) <> "" Then
For Each vbaObje In ActiveSheet.OLEObjects
For j = 0 To UBound(killOleObjectType)
If UCase(Split(vbaObje.ProgId, ".")(1)) = UCase(killOleObjectType(j)) Then
vbaObje.Select: Selection.Delete
End If
Next
Next
End If
Else
'删除整个模块
vbeComp.Remove vbeComp(i)
i = i - 1
End If
Next
removeExcelMacro = True
Exit Function
ErrHand:
MsgBox Err.Description & vbCrLf & vbCrLf & "请与XXX联系！", vbOKOnly + vbCritical
End Function