|
|
另外，还要增加代码，让加裁宏在另外前，将自动安装的部分代码自杀。
以下代码，请大家测试完善：
Option Explicit
Sub auto_open()
Dim MyPath$, Myname$, AddIname$
On Error Resume Next
MyPath = Replace(Application.StartupPath, "Excel\XLSTART", "AddIns")
Myname = MyPath & "\" & ThisWorkbook.Name
AddIname = Replace(ThisWorkbook.Name, ".xla", "")
Call 信任VBA访问
Call 引用
Call 代码自杀
ThisWorkbook.SaveCopyAs (Myname)
''注册加载宏
Shell "regsvr32 /s" & AddIname
AddIns(AddIname).Installed = True ''当已加载宏名称里存在该名称时才行,否则出错。
MsgBox "加载宏已成功安装！", vbOKOnly + 64, "恭喜你 ^_^"
ThisWorkbook.Close (False)
End Sub
Sub 信任VBA访问() '
Dim WshShell As Object
Set WshShell = CreateObject("WScript.Shell")
WshShell.RegWrite "HKCU\Software\Microsoft\Office\11.0\Excel\Security\AccessVBOM", 1, "REG_DWORD"
Set WshShell = Nothing
End Sub
Sub 引用()
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromGuid _
"{0002E157-0000-0000-C000-000000000046}", 5, 3 '引用Extensibility
Application.ScreenUpdating = False
Application.SendKeys "%(qtmstv){ENTER}" '勾选"信任对于VB项目的访问’
Application.ScreenUpdating = True
End Sub
Sub 代码自杀()
On Error Resume Next
Application.VBE.ActiveVBProject.VBComponents.Remove _
Application.VBE.ActiveVBProject.VBComponents("auto_open") '移除模块
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2010-10-5 16:56
楼主
