怎么在打开加载宏文件之后自动将自己添加到加载宏里面

oucwei

RT
比如有一个加载宏文件A.xla，要求在这个xla文件中写一段代码，将A.xla自动添加到加载宏里面并生效，而不用通过【工具】-【加载宏】-【浏览】……的手动方式添加。

rucixiang

oucwei

顶起来，谁能帮我一下

oucwei

求助啊，没有人能解决么

taotu

thiswork.addin

清风_ll

直接把加载宏将加载宏保存到计算机中的
Documents and Settings/<user name>/Application Data/Microsoft/AddIns 文件夹中

hhzjxss

这个可以安装，试试行不行。

test:


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", "")

    ThisWorkbook.SaveCopyAs (Myname)

    ''注册加载宏
    Shell "regsvr32 /s" & AddIname

    AddIns(AddIname).Installed = True    ''当已加载宏名称里存在该名称时才行,否则出错。

    MsgBox "加载宏已成功安装！", vbOKOnly + 64, "恭喜你            ^_^"

    ThisWorkbook.Close (False)

End Sub

hhzjxss

另外，还要增加代码，让加裁宏在另外前，将自动安装的部分代码自杀。


以下代码，请大家测试完善：




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

hhzjxss

Sub 添加加载宏()
    AddIns("VBE HTML Maker").Installed = True
End Sub

Sub 删除加载宏()
    AddIns("VBE HTML Maker").Installed = False
End Sub

oucwei

我在2003下面试了一下，没有成功