[分享]轻松的自动卸载与添加加载宏

ldy

Excel添加加载宏后，在加载宏列表里出现加载宏的名称
但Excel没有提供清除加载宏的功能，虽然不影响使用，但看起来不爽。
只能手动清除:
去掉加载宏的勾
找到加载宏的文件重命名

重新勾选加载宏，这时Excel才提示，可以从加载宏列表中删除。

但从加载宏列表里看不到相关信息，找起来可麻烦了。

运行下面代码可以完成加载宏重命名，
再重新在勾选加载宏，就可以彻底清除了

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub ClearAddin()
    addinNM = "Test" '要清除的加载宏名称
    s1 = AddIns(addinNM).FullName '加载宏的绝对路径
    sPath = AddIns(addinNM).Path '加载宏所在文件夹
    ars = Split(s1, "\")
    ars(UBound(ars)) = "已清除" & ars(UBound(ars))
    s2 = Join(ars, "\") '重命名
    AddIns(addinNM).Installed = False '去掉勾,郁闷的是AddIns集合也没提供Remonve方法
    Name s1 As s2 ' 执行重命名
    AddIns(addinNM).Installed = True
  'API函数打加载宏所在文件夹，看看到底在哪
   ShellExecute 0, "Open", sPath, "", "", 1
End Sub

[此贴子已经被作者于2008-3-16 9:50:09编辑过]

fecmen

老大，我怎样才能实现打开加载宏文件时自动把加载宏加载到“加载宏”列表中呢？

ldy

加载宏的Workbook_Open 事件中添加判断代码：

大概就这样吧，具体请自己调试

Private Sub Workbook_Open()
    i = 0
    ss = Replace(UCase(ThisWorkbook.Name), ".XLA", "")
    For Each adds In AddIns
        If UCase(adds.Title) = ss Then i = 1
    Next
    If i = 0 Then
        AddIns.Add Filename:=ThisWorkbook.FullName
    Else
        Exit Sub
    End If

End Sub

fecmen

老大，在运行到代码AddIns.Add Filename:=ThisWorkbook.FullName时出错，提示add方法无效

ldy

如果在不打开EXCEL的情况下运行  .xla文件

Workbook_Open事件中

加一句 Workbooks.Add 在最前面

[此贴子已经被作者于2008-3-16 0:05:30编辑过]

fecmen

老大，你很伟大啊！

按你说的

Private Sub Workbook_Open()
   Workbooks.Add
   i = 0
    ss = Replace(UCase(ThisWorkbook.Name), ".XLA", "")
    For Each adds In AddIns
        If UCase(adds.Title) = ss Then i = 1
    Next
    If i = 0 Then
        AddIns.Add Filename:=ThisWorkbook.FullName
    Else
        Exit Sub
    End If
End Sub

可以把加载宏文件放到加载宏列表中，但是为什么他不会被勾选呢？请问怎么实现呢？

fecmen

老大，刚才整了一下，放下这样可以加载到列表中呢！呵呵，受你启发啊。

Private Sub Workbook_Open()
   Workbooks.Add
   i = 0
    ss = Replace(UCase(ThisWorkbook.Name), ".XLA", "")
    For Each adds In AddIns
        If UCase(adds.Title) = ss Then i = 1
    Next
    If i = 0 Then
        AddIns.Add Filename:=ThisWorkbook.FullName
        AddIns(ss).Installed = True
    Else
        Exit Sub
    End If
End Sub

ldy

 If i = 0 Then

        Workbooks.Add '试了一下，加在这里比较好，要不然每次打开EXCEL就会打开一个新文件
        AddIns.Add Filename:=ThisWorkbook.FullName
        AddIns(ss).Installed = True
    Else

fecmen

老大，之前还真没注意到此处，还真是这样啊！谢谢啦！

fecmen

这帖子不错！再支持下！